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