         MACRO                                                          00000010
&CSECT   PLIANF &DSALEN                                                 00000020
.*********************************************************************  00000030
.*    THIS MACRO GENERATES PROLOGUE AND RETURN CODE FOR A               00000040
.*    REENTRANT ASSEMBLER SUBROUTINE CALLED BY A PL/I ROUTINE.          00000050
.*                                                                      00000060
.*  PARAMETERS:                                                         00000070
.*    &CSECT  : CSECTNAME FOR THE ASSEMBLER SUBROUTINE.                 00000080
.*    &DSALEN : LENGTH OF THE DSA ADDRESSED BY REGISTER 13,             00000090
.*                IN EXCESS OF 88, MUST BE A MULTIPLE OF 8.             00000100
.*                                                                      00000110
.*  CONVENTIONS:                                                        00000120
.*    START LABEL FOR THE EXECUTABLE CODE MUST BE "START".              00000130
.*    RETURN TO THE CALLLER:   "     B     RETURN ".                    00000140
.*    NAME OF THE DSA DSECT:   "PLIDSA" .                               00000150
.*    BASE REGISTER :  REGISTER 3.                                      00000160
.*********************************************************************  00000170
         LCLA  &IND,&LEN                                                00000180
&IND     SETA  &SYSNDX                                                  00000190
&LEN     SETA  K'&CSECT                                                 00000200
&CSECT.1 CSECT                                                          00000210
         DC    CL7' '                                                   00000220
         ORG   *-&LEN                                                   00000230
         DC    C'&CSECT'                                                00000240
         DC    AL1(&LEN)                                                00000250
         SPACE 3                                                        00000260
R0       EQU   0                                                        00000270
R1       EQU   1                                                        00000280
R2       EQU   2                                                        00000290
R3       EQU   3              BASE REG, POINTS TO ENTRY                 00000300
R4       EQU   4                                                        00000310
R5       EQU   5                                                        00000320
R6       EQU   6                                                        00000330
R7       EQU   7                                                        00000340
R8       EQU   8                                                        00000350
R9       EQU   9                                                        00000360
R10      EQU   10                                                       00000370
R11      EQU   11                                                       00000380
R12      EQU   12             DO NOT ALTER REGISTER 12                  00000390
R13      EQU   13             BASE FOR PLIDSA DSECT                     00000400
R14      EQU   14                                                       00000410
R15      EQU   15                                                       00000420
         SPACE 3                                                        00000430
PLIDSA   DSECT                                                          00000440
PLIFLAGS DS    H                                                        00000450
PLIOFFS  DS    H                                                        00000460
PLIHSA   DS    F                                                        00000470
PLILSA   DS    F                                                        00000480
PLIREG14 DS    F                                                        00000490
PLIREG15 DS    F                                                        00000500
PLIREG0  DS    F                                                        00000510
PLIREG1  DS    F                                                        00000520
PLIREG2  DS    F                                                        00000530
PLIREG3  DS    F                                                        00000540
PLIREG4  DS    F                                                        00000550
PLIREG5  DS    F                                                        00000560
PLIREG6  DS    F                                                        00000570
PLIREG7  DS    F                                                        00000580
PLIREG8  DS    F                                                        00000590
PLIREG9  DS    F                                                        00000600
PLIREG10 DS    F                                                        00000610
PLIREG11 DS    F                                                        00000620
PLIREG12 DS    F                                                        00000630
PLILWS   DS    A                                                        00000640
PLINAB   DS    A                                                        00000650
PLIPNAB  DS    A                                                        00000660
PLIENABC DS    F                                                        00000670
         EJECT                                                          00000680
&CSECT.1 CSECT                                                          00000690
         ENTRY &CSECT                                                   00000700
&CSECT   DS    0H                                                       00000710
         STM   R14,R12,12(R13)                                          00000720
         LR    R3,R15         R3 : BASE REGISTER                        00000730
         USING &CSECT,R3                                                00000740
         USING PLIDSA,R13                                               00000750
         LA    R0,88+&DSALEN                                            00000760
         L     R1,PLINAB      R1 : NEXT AVAILABLE BYTE                  00000770
         ALR   R0,R1                                                    00000780
         CL    R0,12(R12)     ENOUGH STORAGE ?                          00000790
         BNH   ENGH&IND                                                 00000800
         L     R15,116(R12)   NO,                                       00000810
         BALR  R14,R15           BRANCH TO PL/I OVERFLOW ROUTINE        00000820
ENGH&IND EQU   *                                                        00000830
         ST    R0,76(R1)      RESET NAB                                 00000840
         ST    R0,80(R1)      RESET PROLOGUE NAB                        00000850
         ST    13,4(R1)       STORE BACK-CHAIN                          00000860
         MVC   72(4,R1),PLILWS     COPY LWS ADDRESS                     00000870
         LR    R13,R1         R13 : BASE OF PLIDSA DSECT                00000880
         MVI   PLIFLAGS,X'80'     SET PL/I                              00000890
         MVI   PLIFLAGS+1,X'00'     FLAGS                               00000900
         MVI   PLIENABC+2,X'91'   INITIALIZE CURRENT                    00000910
         MVI   PLIENABC+3,X'C0'     ENABLE CELLS                        00000920
         L     R1,PLIHSA      GET BACK                                  00000930
         L     R1,24(R1)        PARAMETER REGISTER                      00000940
         B     START          BRANCH TO USER'S CODE                     00000950
         SPACE 3                                                        00000960
RETURN   EQU   *                                                        00000970
         LR    R0,R13                                                   00000980
         L     R13,PLIHSA                                               00000990
         L     R14,PLIREG14                                             00001000
         LM    R2,R12,PLIREG2                                           00001010
         BALR  R1,R14                                                   00001020
         EJECT                                                          00001030
         MEND                                                           00001040
                                                                        00001050
PLNK     TITLE 'PL/I - LINK INTERFACE'                                  00001060
**********************************************************************  00001070
*   PL/I INTERFACE TO LINK SVC                                          00001080
*                                                                       00001090
*  DECLARATION :                                                        00001100
*      DCL PLILINK ENTRY(CHAR(8),...)                                   00001200
*                  OPTIONS(ASM INTER RETCODE);                          00001300
*                                                                       00001400
*  USE :  CALL PLILINK(EPNAME,PARMS);                                   00001500
*                                                                       00001600
*  PARAMETERS :                                                         00001700
*         EPNAME : NAME OF ENTRY POINT.                                 00001800
*         PARMS  : PARAMETERS TO BE PASSED.                             00001900
*                                                                       00002000
*  RETURN CODE :  PASSED FROM LINKED PROGRAM                            00002100
*                                                                       00002200
*  MACRO USED : PLIANF                                                  00002300
**********************************************************************  00002400
         SPACE 3                                                        00002500
PLILINK  PLIANF DSALEN                                                  00002600
START    EQU   *                                                        00002700
         L     R4,0(R1)       GET EPNAME                                00002800
         LA    R1,4(R1)       CUT FIRST PARAMETER                       00002900
         MVC   LINKLIST(INITLEN),LISTINIT   INITIALIZE WORKSTORAGE      00003000
         LA    R13,0(R13)     CLEAR R13 (ERROR IN MVS XA SVC 6) WS      00003100
LINK     LINK  EPLOC=(4),MF=(E,(1)),SF=(E,LINKLIST)                     00003200
         B     RETURN                                                   00003300
         SPACE                                                          00003400
LISTINIT DS    0F                                                       00003500
LINKINIT LINK  EPLOC=*-*,SF=L                                           00003600
INITLEN  EQU   *-LISTINIT                                               00003700
         SPACE 2                                                        00003800
PLIDSA   DSECT                                                          00003900
LINKLIST LINK  EPLOC=*-*,SF=L                                           00004000
         DS    0D                                                       00004100
DSALEN   EQU   *-LINKLIST                                               00004200
         END                                                            00004300
                                                                        00004400
PSVC     TITLE 'PL/I - SVC INTERFACE'                                   00004500
**********************************************************************  00004600
*   PL/I INTERFACE TO GENERAL SVC                                       00004700
*                                                                       00004800
*  DECLARATION :                                                        00004900
*      DCL PLISVC ENTRY(BIN(15,0),BIN(31,0),BIN(31,0),BIN(31,0));       00005000
*                                                                       00005100
*  USE :  CALL PLISVC(SVCNR,REG0,REG1,REG15);                           00005200
*                                                                       00005300
*  PARAMETERS :                                                         00005400
*         SVCNR : NUMBER OF SVC TO BE EXECUTED                          00005500
*         REG0,REG1,REG15 : VALUES TO BE LOADED INTO REGISTERS          00005600
*                0,1,15 RESPECTIVELY ON ENTRY TO SVC.                   00005700
*               THEY ARE RESTORED ON RETURN FROM SVC.                   00005800
*                                                                       00005900
*  MACRO USED : PLIANF                                                  00006000
**********************************************************************  00006100
         SPACE 3                                                        00006200
PLISVC   PLIANF 0                                                       00006300
START    EQU   *                                                        00006400
         LM    R4,R7,0(R1)    GET PARAMETERS                            00006500
         LH    R8,0(R4)       GET SVCNR                                 00006600
         L     R0,0(R5)       LOAD REGISTER 0 VALUE                     00006700
         L     R1,0(R6)       LOAD REGISTER 1 VALUE                     00006800
         L     R15,0(R7)      LOAD REGISTER 15 VALUE                    00006900
         EX    R8,SVC         EXECUTE SVC                               00007000
         ST    R0,0(R5)       RESTORE REGISTER 0 VALUE                  00007100
         ST    R1,0(R6)       RESTORE REGISTER 1 VALUE                  00007200
         ST    R15,0(R7)      RESTORE REGISTER 15 VALUE                 00007300
         B     RETURN         RETURN                                    00007400
         SPACE 2                                                        00007500
SVC      SVC   0              MODEL SVC INSTRUCTION                     00007600
         END                                                            00007700
                                                                        00007800
PTSR     TITLE 'PL/I - INTERFACE TO TSO SERVICE ROUTINES'               00007900
**********************************************************************  00008000
*   PL/I INTERFACE TO TSO SERVICE ROUTINES                              00008100
*                                                                       00008200
*  DECLARATION :                                                        00008300
*      DCL PLITSSR ENTRY(CHAR(8),...)                                   00008400
*                  OPTIONS(ASM INTER RETCODE);                          00008500
*                                                                       00008600
*  USE :  CALL PLITSSR(EPNAME,PARMS);                                   00008700
*                                                                       00008800
*  PARAMETERS :                                                         00008900
*         EPNAME : NAME OF ENTRY POINT.                                 00009000
*         PARMS  : PARAMETERS TO BE PASSED.                             00009100
*                                                                       00009200
*  RETURN CODE :  PASSED FROM TSO SERVICE ROUTINE                       00009300
*                                                                       00009400
*  MACRO USED : PLIANF                                                  00009500
**********************************************************************  00009600
         SPACE 3                                                        00009700
PLITSSR  PLIANF DSALEN                                                  00009800
START    EQU   *                                                        00009900
         L     R4,0(R1)       GET EPNAME                                00010000
         LA    R1,4(R1)       CUT FIRST PARAMETER                       00010100
         LA    R5,TSSRTAB-LENENTRY                                      00010200
         LA    R6,LENENTRY                                              00010300
         LA    R7,TABEND-LENENTRY                                       00010400
TSSRLOOP BXH   R5,R6,NOTFOUND                                           00010500
         CLC   0(LENNAME,R3),0(R5)                                      00010600
         BNE   TSSRLOOP                                                 00010700
FOUND    EQU   *                                                        00010800
         L     R15,16              GET CVT ADDRESS                      00010900
         AL    R15,(LENNAME)(R5)   ADD OFFSET FROM LIST ENTRY           00011000
         TM    0(R15),X'80'        TEST IF ADDRESS VALID                00011100
         BNO   NOTFOUND            NO, DO NORMAL LINK                   00011200
         L     R15,0(R15)          GET SERVICE ROUTINE ADDRESS          00011300
         BALR  R14,R15             OFF TO SERVICE ROUTINE               00011400
         B     RETURN                                                   00011500
NOTFOUND EQU   *                                                        00011600
         MVC   LINKLIST(INITLEN),LISTINIT   INITIALIZE WORKSTORAGE      00011700
LINK     LINK  EPLOC=(4),MF=(E,(1)),SF=(E,LINKLIST)                     00011800
         B     RETURN                                                   00011900
         SPACE                                                          00012000
LISTINIT DS    0F                                                       00012100
LINKINIT LINK  EPLOC=*-*,SF=L                                           00012200
INITLEN  EQU   *-LISTINIT                                               00012300
         SPACE 2                                                        00012400
*  TABLE OF MVS TSO SERVICE ROUTINE ADDRESSES IN CVT                    00012500
         SPACE                                                          00012600
*  TO ACTIVATE TABLE FOR MVS, REMOVE STARS ON EACH ENTRY                00012700
*  AND ON CVT DSECT=YES AND REASSEMBLE.                                 00012800
         SPACE                                                          00012900
TSSRTAB  DS    0F                                                       00013000
LENNAME  EQU   8                                                        00013100
LENENTRY EQU   12                                                       00013200
GETL     DC    CL(LENNAME)'IKJGETL',A(CVTGETL-CVT)                      00013300
PUTL     DC    CL(LENNAME)'IKJPUTL',A(CVTPUTL-CVT)                      00013400
PTGT     DC    CL(LENNAME)'IKJPTGT',A(CVTPTGT-CVT)                      00013500
STCK     DC    CL(LENNAME)'IKJSTCK',A(CVTSTCK-CVT)                      00013600
SCAN     DC    CL(LENNAME)'IKJSCAN',A(CVTSCAN-CVT)                      00013700
PARS     DC    CL(LENNAME)'IKJPARS',A(CVTPARS-CVT)                      00013800
DAIR     DC    CL(LENNAME)'IKJDAIR',A(CVTDAIR-CVT)                      00013900
EHDEF    DC    CL(LENNAME)'IKJEHDEF',A(CVTEHDEF-CVT)                    00014000
EHCIR    DC    CL(LENNAME)'IKJEHCIR',A(CVTEHCIR-CVT)                    00014100
EFF02    DC    CL(LENNAME)'IKJEFF02',A(CVTEFF02-CVT)                    00014200
TABEND   EQU   *                                                        00014300
         SPACE 2                                                        00014400
         CVT   DSECT=YES                                                00014500
         SPACE 3                                                        00014600
PLIDSA   DSECT                                                          00014700
LINKLIST LINK  EPLOC=*-*,SF=L                                           00014800
         DS    0D                                                       00014900
DSALEN   EQU   *-LINKLIST                                               00015000
         END                                                            00015100
