Cpinf
Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
* CPINF IST JETZT CONTINGENCY. TYPIOS GEHEN MIT LEVEL 5, REST LEVEL 10 ** V1.3D40 * AENDERUNG CMD 'TYPE' AUF TYPIO-MAKRO WEGEN HAENGER (EVTL. CONSOLE * BUSY) ** V1.3D30 CPINF CSECT PRINT NOGEN,BASE *----------------------------------------------------------------------* **** INIT REGISTERS **** *----------------------------------------------------------------------* SPACE R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 *---------------------------------------------------------------------* GPARMOD 31 CPINF AMODE ANY CPINF RMODE ANY ##BAL OPSYN ##BAS ##BALR OPSYN ##BASR *---------------------------------------------------------------------* USING *,R15 USING USEREIN,R4 * USING STATEIN,R3 STM R0,R13,SAVTAB ST R14,SAV14 SPACE USING UCPINF,R8,R9 UCPINF BASR R8,0 BCTR R8,R0 BCTR R8,R0 LA R1,4095 LA R9,1(R8,R1) DROP 15 ST R15,SAV15 B BEG *----------------------------------------------------------------------* *** INFO - MODUL *** *----------------------------------------------------------------------* CNOP 0,4 BEG EQU * XR R1,R1 TRT 0(8,R7),TRTAB BZ BEG1 STC R2,0(R1) BEG1 EQU * L R5,=X'00001F40' CLI 8(R7),C'R' BE CR1 CLI 8(R7),C'A' BE CA1 *----------------------------------------------------------------------* *** INFO - VIRTUELLE TERMINALS 'V' *** *----------------------------------------------------------------------* CI1 EQU * XC 0(1,R6),=X'00' BNZ CI2 LA R6,9(R6) BCT R5,CI1 CINOF1 EQU * B CINOF2 CI2 ICM R4,B'1111',1(R6) CLC 0(8,R7),USCPNAME BE CI3 LA R6,9(R6) BCT R5,CI1 CINOF2 EQU * CNOP 0,4 MVC TCI3CMD+20(8),0(R7) ANGEFORDERTES OBJEKT CI3CMD TYPIO MSG=LCI3CMD B CIRET CI3 EQU * ICM R4,B'1111',1(R6) PRINT GEN,BASE CNOP 0,4 MVC TCICMD+12(8),USCPNAME MVC TCICMD+42(8),USPNA MVC TCICMD+51(8),USPRO MVC TCICMD+66(8),USTATPNA MVC TCICMD+81(8),USTATPRO MVC TCICMD+96(4),USTYP 59 CICMD TYPIO MSG=LCICMD B CIRET DS 0F LCI3CMD DC Y(ECI3CMD-LCI3CMD) DS CL2 TCI3CMD DC C' % ZCP0061 ELEMENT XXXXXXXX NOT FOUND.' ECI3CMD EQU * DS 0F LCICMD DC Y(ECICMD-LCICMD) DS CL2 TCICMD DC C' % ZCP0060 CPTERMXX: CONNECTED WITH APPL=XXXXXXXX/XXX- XXXXX; TERM=XXXXXXXX, PROC=XXXXXXXX, TYPE=XXXX.' ECICMD EQU * DS 0F *----------------------------------------------------------------------* *** INFO - REELLE TERMINALS 'R' *** *----------------------------------------------------------------------* CR1 EQU * XC 0(1,R6),=X'00' BNZ CR2 LA R6,9(R6) BCT R5,CR1 CRNOF1 EQU * B CR2NOP CR2 ICM R4,B'1111',1(R6) CLC 0(8,R7),USTATPNA BE CR3 CR2R LA R6,9(R6) BCT R5,CR1 CR2NOP NOP CIRET CRNOF2 EQU * MVC TCR3CMD+20(8),0(R7) ANGEFORDERTES OBJEKT CNOP 0,4 CR3CMD TYPIO MSG=LCR3CMD B CIRET CR3 EQU * ICM R4,B'1111',1(R6) PRINT GEN,BASE MVC TCRCMD+12(8),USTATPNA MVC TCRCMD+21(8),USTATPRO MVC TCRCMD+36(8),USCPNAME MVC TCRCMD+51(8),USPNA CNOP 0,4 LEVCO NEWLV=5 CRCMD TYPIO MSG=LCRCMD LEVCO NEWLV=10 MVI CR2NOP+1,X'F0' B CR2R B CIRET DS 0F LCR3CMD DC Y(ECR3CMD-LCR3CMD) DS CL2 TCR3CMD DC C' % ZCP0061 ELEMENT XXXXXXXX NOT FOUND.' ECR3CMD EQU * DS 0F LCRCMD DC Y(ECRCMD-LCRCMD) DS CL2 TCRCMD DC C' % ZCP0062 XXXXXXXX/XXXXXXXX VTERM:XXXXXXXX; APPL=XXX- XXXXX' ECRCMD EQU * DS 0F *----------------------------------------------------------------------* *** INFO - APPLIKATIONEN 'A' *** *----------------------------------------------------------------------* CA1 EQU * XC 0(1,R6),=X'00' BNZ CA2 LA R6,9(R6) BCT R5,CA1 CANOF1 EQU * B CA2NOP CA2 ICM R4,B'1111',1(R6) CLC 0(8,R7),USPNA BE CA3 CA2R LA R6,9(R6) BCT R5,CA1 CA2NOP NOP CIRET CANOF2 EQU * MVC TCA3CMD+20(8),0(R7) ANGEFORDERTES OBJEKT CNOP 0,4 CA3CMD TYPIO MSG=LCA3CMD B CIRET CA3 EQU * ICM R4,B'1111',1(R6) PRINT GEN,BASE MVC TCACMD1+18(8),USCPNAME MVC TCACMD1+33(8),USTATPNA MVC TCACMD1+42(8),USTATPRO CA3NOP1 NOP CA3NOPX MVC TCACMD+24(8),USPNA CNOP 0,4 59 CACMD TYPIO MSG=LCACMD CA3NOPX EQU * CNOP 0,4 59 LEVCO NEWLV=5 CACMD1 TYPIO MSG=LCACMD1 LEVCO NEWLV=10 MVI CA2NOP+1,X'F0' MVI CA3NOP1+1,X'F0' B CA2R B CIRET DS 0F LCA3CMD DC Y(ECA3CMD-LCA3CMD) DS CL2 TCA3CMD DC C' % ZCP0061 ELEMENT XXXXXXXX NOT FOUND.' ECA3CMD EQU * DS 0F LCACMD DC Y(ECACMD-LCACMD) DS CL2 TCACMD DC C' % ZCP0063 APPLICATION XXXXXXXX CONNECTED WITH:' ECACMD EQU * DS 0F LCACMD1 DC Y(ECACMD1-LCACMD1) DS CL2 18 33 42 TCACMD1 DC C' % ZCP0063 VTERM=XXXXXXXX; TERM=XXXXXXXX/XXXXXXXX' ECACMD1 EQU * DS 0F *----------------------------------------------------------------------* CIRET EQU * CNOP 0,4 59 MVI CR2NOP+1,X'00' MVI CA2NOP+1,X'00' MVI CA3NOP1+1,X'00' L R15,SAV15 USING CPINF,R15 L R14,SAV14 LM R0,R13,SAVTAB BR R14 *----------------------------------------------------------------------* DS 0F SAVTAB DS 14F SAV15 DS F SAV14 DS F DS 0D TRTAB DC 256X'00' ORG TRTAB DC X'40' ORG TRTAB+256 DS 0F *---------------------------------------------------------------------* *** D S E C T S *** *---------------------------------------------------------------------* *---- ZENTRALE TABELLEN ------------------------------------------* STATEIN EJECT USEREIN *---------------------------------------------------------------------* END