home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ibmtsoqueens / ts2ds.asm next >
Assembly Source File  |  2020-01-01  |  20KB  |  251 lines
  1.          MACRO                                                          00000010
  2. &CSECT   PLIANF &DSALEN                                                 00000020
  3. .*********************************************************************  00000030
  4. .*    THIS MACRO GENERATES PROLOGUE AND RETURN CODE FOR A               00000040
  5. .*    REENTRANT ASSEMBLER SUBROUTINE CALLED BY A PL/I ROUTINE.          00000050
  6. .*                                                                      00000060
  7. .*  PARAMETERS:                                                         00000070
  8. .*    &CSECT  : CSECTNAME FOR THE ASSEMBLER SUBROUTINE.                 00000080
  9. .*    &DSALEN : LENGTH OF THE DSA ADDRESSED BY REGISTER 13,             00000090
  10. .*                IN EXCESS OF 88, MUST BE A MULTIPLE OF 8.             00000100
  11. .*                                                                      00000110
  12. .*  CONVENTIONS:                                                        00000120
  13. .*    START LABEL FOR THE EXECUTABLE CODE MUST BE "START".              00000130
  14. .*    RETURN TO THE CALLLER:   "     B     RETURN ".                    00000140
  15. .*    NAME OF THE DSA DSECT:   "PLIDSA" .                               00000150
  16. .*    BASE REGISTER :  REGISTER 3.                                      00000160
  17. .*********************************************************************  00000170
  18.          LCLA  &IND,&LEN                                                00000180
  19. &IND     SETA  &SYSNDX                                                  00000190
  20. &LEN     SETA  K'&CSECT                                                 00000200
  21. &CSECT.1 CSECT                                                          00000210
  22.          DC    CL7' '                                                   00000220
  23.          ORG   *-&LEN                                                   00000230
  24.          DC    C'&CSECT'                                                00000240
  25.          DC    AL1(&LEN)                                                00000250
  26.          SPACE 3                                                        00000260
  27. R0       EQU   0                                                        00000270
  28. R1       EQU   1                                                        00000280
  29. R2       EQU   2                                                        00000290
  30. R3       EQU   3              BASE REG, POINTS TO ENTRY                 00000300
  31. R4       EQU   4                                                        00000310
  32. R5       EQU   5                                                        00000320
  33. R6       EQU   6                                                        00000330
  34. R7       EQU   7                                                        00000340
  35. R8       EQU   8                                                        00000350
  36. R9       EQU   9                                                        00000360
  37. R10      EQU   10                                                       00000370
  38. R11      EQU   11                                                       00000380
  39. R12      EQU   12             DO NOT ALTER REGISTER 12                  00000390
  40. R13      EQU   13             BASE FOR PLIDSA DSECT                     00000400
  41. R14      EQU   14                                                       00000410
  42. R15      EQU   15                                                       00000420
  43.          SPACE 3                                                        00000430
  44. PLIDSA   DSECT                                                          00000440
  45. PLIFLAGS DS    H                                                        00000450
  46. PLIOFFS  DS    H                                                        00000460
  47. PLIHSA   DS    F                                                        00000470
  48. PLILSA   DS    F                                                        00000480
  49. PLIREG14 DS    F                                                        00000490
  50. PLIREG15 DS    F                                                        00000500
  51. PLIREG0  DS    F                                                        00000510
  52. PLIREG1  DS    F                                                        00000520
  53. PLIREG2  DS    F                                                        00000530
  54. PLIREG3  DS    F                                                        00000540
  55. PLIREG4  DS    F                                                        00000550
  56. PLIREG5  DS    F                                                        00000560
  57. PLIREG6  DS    F                                                        00000570
  58. PLIREG7  DS    F                                                        00000580
  59. PLIREG8  DS    F                                                        00000590
  60. PLIREG9  DS    F                                                        00000600
  61. PLIREG10 DS    F                                                        00000610
  62. PLIREG11 DS    F                                                        00000620
  63. PLIREG12 DS    F                                                        00000630
  64. PLILWS   DS    A                                                        00000640
  65. PLINAB   DS    A                                                        00000650
  66. PLIPNAB  DS    A                                                        00000660
  67. PLIENABC DS    F                                                        00000670
  68.          EJECT                                                          00000680
  69. &CSECT.1 CSECT                                                          00000690
  70.          ENTRY &CSECT                                                   00000700
  71. &CSECT   DS    0H                                                       00000710
  72.          STM   R14,R12,12(R13)                                          00000720
  73.          LR    R3,R15         R3 : BASE REGISTER                        00000730
  74.          USING &CSECT,R3                                                00000740
  75.          USING PLIDSA,R13                                               00000750
  76.          LA    R0,88+&DSALEN                                            00000760
  77.          L     R1,PLINAB      R1 : NEXT AVAILABLE BYTE                  00000770
  78.          ALR   R0,R1                                                    00000780
  79.          CL    R0,12(R12)     ENOUGH STORAGE ?                          00000790
  80.          BNH   ENGH&IND                                                 00000800
  81.          L     R15,116(R12)   NO,                                       00000810
  82.          BALR  R14,R15           BRANCH TO PL/I OVERFLOW ROUTINE        00000820
  83. ENGH&IND EQU   *                                                        00000830
  84.          ST    R0,76(R1)      RESET NAB                                 00000840
  85.          ST    R0,80(R1)      RESET PROLOGUE NAB                        00000850
  86.          ST    13,4(R1)       STORE BACK-CHAIN                          00000860
  87.          MVC   72(4,R1),PLILWS     COPY LWS ADDRESS                     00000870
  88.          LR    R13,R1         R13 : BASE OF PLIDSA DSECT                00000880
  89.          MVI   PLIFLAGS,X'80'     SET PL/I                              00000890
  90.          MVI   PLIFLAGS+1,X'00'     FLAGS                               00000900
  91.          MVI   PLIENABC+2,X'91'   INITIALIZE CURRENT                    00000910
  92.          MVI   PLIENABC+3,X'C0'     ENABLE CELLS                        00000920
  93.          L     R1,PLIHSA      GET BACK                                  00000930
  94.          L     R1,24(R1)        PARAMETER REGISTER                      00000940
  95.          B     START          BRANCH TO USER'S CODE                     00000950
  96.          SPACE 3                                                        00000960
  97. RETURN   EQU   *                                                        00000970
  98.          LR    R0,R13                                                   00000980
  99.          L     R13,PLIHSA                                               00000990
  100.          L     R14,PLIREG14                                             00001000
  101.          LM    R2,R12,PLIREG2                                           00001010
  102.          BALR  R1,R14                                                   00001020
  103.          EJECT                                                          00001030
  104.          MEND                                                           00001040
  105.                                                                         00001050
  106. PLNK     TITLE 'PL/I - LINK INTERFACE'                                  00001060
  107. **********************************************************************  00001070
  108. *   PL/I INTERFACE TO LINK SVC                                          00001080
  109. *                                                                       00001090
  110. *  DECLARATION :                                                        00001100
  111. *      DCL PLILINK ENTRY(CHAR(8),...)                                   00001200
  112. *                  OPTIONS(ASM INTER RETCODE);                          00001300
  113. *                                                                       00001400
  114. *  USE :  CALL PLILINK(EPNAME,PARMS);                                   00001500
  115. *                                                                       00001600
  116. *  PARAMETERS :                                                         00001700
  117. *         EPNAME : NAME OF ENTRY POINT.                                 00001800
  118. *         PARMS  : PARAMETERS TO BE PASSED.                             00001900
  119. *                                                                       00002000
  120. *  RETURN CODE :  PASSED FROM LINKED PROGRAM                            00002100
  121. *                                                                       00002200
  122. *  MACRO USED : PLIANF                                                  00002300
  123. **********************************************************************  00002400
  124.          SPACE 3                                                        00002500
  125. PLILINK  PLIANF DSALEN                                                  00002600
  126. START    EQU   *                                                        00002700
  127.          L     R4,0(R1)       GET EPNAME                                00002800
  128.          LA    R1,4(R1)       CUT FIRST PARAMETER                       00002900
  129.          MVC   LINKLIST(INITLEN),LISTINIT   INITIALIZE WORKSTORAGE      00003000
  130.          LA    R13,0(R13)     CLEAR R13 (ERROR IN MVS XA SVC 6) WS      00003100
  131. LINK     LINK  EPLOC=(4),MF=(E,(1)),SF=(E,LINKLIST)                     00003200
  132.          B     RETURN                                                   00003300
  133.          SPACE                                                          00003400
  134. LISTINIT DS    0F                                                       00003500
  135. LINKINIT LINK  EPLOC=*-*,SF=L                                           00003600
  136. INITLEN  EQU   *-LISTINIT                                               00003700
  137.          SPACE 2                                                        00003800
  138. PLIDSA   DSECT                                                          00003900
  139. LINKLIST LINK  EPLOC=*-*,SF=L                                           00004000
  140.          DS    0D                                                       00004100
  141. DSALEN   EQU   *-LINKLIST                                               00004200
  142.          END                                                            00004300
  143.                                                                         00004400
  144. PSVC     TITLE 'PL/I - SVC INTERFACE'                                   00004500
  145. **********************************************************************  00004600
  146. *   PL/I INTERFACE TO GENERAL SVC                                       00004700
  147. *                                                                       00004800
  148. *  DECLARATION :                                                        00004900
  149. *      DCL PLISVC ENTRY(BIN(15,0),BIN(31,0),BIN(31,0),BIN(31,0));       00005000
  150. *                                                                       00005100
  151. *  USE :  CALL PLISVC(SVCNR,REG0,REG1,REG15);                           00005200
  152. *                                                                       00005300
  153. *  PARAMETERS :                                                         00005400
  154. *         SVCNR : NUMBER OF SVC TO BE EXECUTED                          00005500
  155. *         REG0,REG1,REG15 : VALUES TO BE LOADED INTO REGISTERS          00005600
  156. *                0,1,15 RESPECTIVELY ON ENTRY TO SVC.                   00005700
  157. *               THEY ARE RESTORED ON RETURN FROM SVC.                   00005800
  158. *                                                                       00005900
  159. *  MACRO USED : PLIANF                                                  00006000
  160. **********************************************************************  00006100
  161.          SPACE 3                                                        00006200
  162. PLISVC   PLIANF 0                                                       00006300
  163. START    EQU   *                                                        00006400
  164.          LM    R4,R7,0(R1)    GET PARAMETERS                            00006500
  165.          LH    R8,0(R4)       GET SVCNR                                 00006600
  166.          L     R0,0(R5)       LOAD REGISTER 0 VALUE                     00006700
  167.          L     R1,0(R6)       LOAD REGISTER 1 VALUE                     00006800
  168.          L     R15,0(R7)      LOAD REGISTER 15 VALUE                    00006900
  169.          EX    R8,SVC         EXECUTE SVC                               00007000
  170.          ST    R0,0(R5)       RESTORE REGISTER 0 VALUE                  00007100
  171.          ST    R1,0(R6)       RESTORE REGISTER 1 VALUE                  00007200
  172.          ST    R15,0(R7)      RESTORE REGISTER 15 VALUE                 00007300
  173.          B     RETURN         RETURN                                    00007400
  174.          SPACE 2                                                        00007500
  175. SVC      SVC   0              MODEL SVC INSTRUCTION                     00007600
  176.          END                                                            00007700
  177.                                                                         00007800
  178. PTSR     TITLE 'PL/I - INTERFACE TO TSO SERVICE ROUTINES'               00007900
  179. **********************************************************************  00008000
  180. *   PL/I INTERFACE TO TSO SERVICE ROUTINES                              00008100
  181. *                                                                       00008200
  182. *  DECLARATION :                                                        00008300
  183. *      DCL PLITSSR ENTRY(CHAR(8),...)                                   00008400
  184. *                  OPTIONS(ASM INTER RETCODE);                          00008500
  185. *                                                                       00008600
  186. *  USE :  CALL PLITSSR(EPNAME,PARMS);                                   00008700
  187. *                                                                       00008800
  188. *  PARAMETERS :                                                         00008900
  189. *         EPNAME : NAME OF ENTRY POINT.                                 00009000
  190. *         PARMS  : PARAMETERS TO BE PASSED.                             00009100
  191. *                                                                       00009200
  192. *  RETURN CODE :  PASSED FROM TSO SERVICE ROUTINE                       00009300
  193. *                                                                       00009400
  194. *  MACRO USED : PLIANF                                                  00009500
  195. **********************************************************************  00009600
  196.          SPACE 3                                                        00009700
  197. PLITSSR  PLIANF DSALEN                                                  00009800
  198. START    EQU   *                                                        00009900
  199.          L     R4,0(R1)       GET EPNAME                                00010000
  200.          LA    R1,4(R1)       CUT FIRST PARAMETER                       00010100
  201.          LA    R5,TSSRTAB-LENENTRY                                      00010200
  202.          LA    R6,LENENTRY                                              00010300
  203.          LA    R7,TABEND-LENENTRY                                       00010400
  204. TSSRLOOP BXH   R5,R6,NOTFOUND                                           00010500
  205.          CLC   0(LENNAME,R3),0(R5)                                      00010600
  206.          BNE   TSSRLOOP                                                 00010700
  207. FOUND    EQU   *                                                        00010800
  208.          L     R15,16              GET CVT ADDRESS                      00010900
  209.          AL    R15,(LENNAME)(R5)   ADD OFFSET FROM LIST ENTRY           00011000
  210.          TM    0(R15),X'80'        TEST IF ADDRESS VALID                00011100
  211.          BNO   NOTFOUND            NO, DO NORMAL LINK                   00011200
  212.          L     R15,0(R15)          GET SERVICE ROUTINE ADDRESS          00011300
  213.          BALR  R14,R15             OFF TO SERVICE ROUTINE               00011400
  214.          B     RETURN                                                   00011500
  215. NOTFOUND EQU   *                                                        00011600
  216.          MVC   LINKLIST(INITLEN),LISTINIT   INITIALIZE WORKSTORAGE      00011700
  217. LINK     LINK  EPLOC=(4),MF=(E,(1)),SF=(E,LINKLIST)                     00011800
  218.          B     RETURN                                                   00011900
  219.          SPACE                                                          00012000
  220. LISTINIT DS    0F                                                       00012100
  221. LINKINIT LINK  EPLOC=*-*,SF=L                                           00012200
  222. INITLEN  EQU   *-LISTINIT                                               00012300
  223.          SPACE 2                                                        00012400
  224. *  TABLE OF MVS TSO SERVICE ROUTINE ADDRESSES IN CVT                    00012500
  225.          SPACE                                                          00012600
  226. *  TO ACTIVATE TABLE FOR MVS, REMOVE STARS ON EACH ENTRY                00012700
  227. *  AND ON CVT DSECT=YES AND REASSEMBLE.                                 00012800
  228.          SPACE                                                          00012900
  229. TSSRTAB  DS    0F                                                       00013000
  230. LENNAME  EQU   8                                                        00013100
  231. LENENTRY EQU   12                                                       00013200
  232. GETL     DC    CL(LENNAME)'IKJGETL',A(CVTGETL-CVT)                      00013300
  233. PUTL     DC    CL(LENNAME)'IKJPUTL',A(CVTPUTL-CVT)                      00013400
  234. PTGT     DC    CL(LENNAME)'IKJPTGT',A(CVTPTGT-CVT)                      00013500
  235. STCK     DC    CL(LENNAME)'IKJSTCK',A(CVTSTCK-CVT)                      00013600
  236. SCAN     DC    CL(LENNAME)'IKJSCAN',A(CVTSCAN-CVT)                      00013700
  237. PARS     DC    CL(LENNAME)'IKJPARS',A(CVTPARS-CVT)                      00013800
  238. DAIR     DC    CL(LENNAME)'IKJDAIR',A(CVTDAIR-CVT)                      00013900
  239. EHDEF    DC    CL(LENNAME)'IKJEHDEF',A(CVTEHDEF-CVT)                    00014000
  240. EHCIR    DC    CL(LENNAME)'IKJEHCIR',A(CVTEHCIR-CVT)                    00014100
  241. EFF02    DC    CL(LENNAME)'IKJEFF02',A(CVTEFF02-CVT)                    00014200
  242. TABEND   EQU   *                                                        00014300
  243.          SPACE 2                                                        00014400
  244.          CVT   DSECT=YES                                                00014500
  245.          SPACE 3                                                        00014600
  246. PLIDSA   DSECT                                                          00014700
  247. LINKLIST LINK  EPLOC=*-*,SF=L                                           00014800
  248.          DS    0D                                                       00014900
  249. DSALEN   EQU   *-LINKLIST                                               00015000
  250.          END                                                            00015100
  251.