Cpauser

Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
Version vom 19. Januar 2016, 02:13 Uhr von Sigi (Diskussion | Beiträge)
(Unterschied) ← Nächstältere Version | Aktuelle Version (Unterschied) | Nächstjüngere Version → (Unterschied)
Zur Navigation springen Zur Suche springen

<syntaxhighlight lang="asm">

  • RELM UEBERPRUEFEN AUF GUELTIGKEIT.
    • V3.0AK4
  • REQM UEBERPRUEFEN AUF GUELTIGKEIT.
    • V3.0AK3
  • KOMMANDO /LL FUER LINELEN 80 ODER 82 BYTE (DUMME PC'S)
  • 'P' = 80 BYTE / REST = 82 BYTE BREITE AUF DRUCKFORMULAR
    • V2.0A00 (PILOT)
  • KOMMANDOS: /HC XXXXXXXX; /FORM XXXXXXXX; /?
    • V2.0A00

CPAUSER CSECT 

        PRINT NOGEN

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

CPAUSER AMODE ANY CPAUSER RMODE ANY

    1. BAL OPSYN ##BAS
    2. BALR OPSYN ##BASR
  • ---------------------------------------------------------------------*
  • > REGISTERUEBERGABE <
  • R3 STATEIN
  • R4 USEREIN
  • R6 PARAMLIST
  • R14 RET. ADRES (BASR R14,R15)
  • > BENUTZTE REGISTER <
  • R1 DIV.
  • R5 SEND AREA
  • R7 SEND CID
  • R8 V(KONST)/ ARBEIT
  • R9 BASIS REG
  • R10 BASIS REG
  • R11 BASIS REG
  • R12 SEND AREALN
  • R13 SPRUNG REG / SEND RPB
  • R15 DIV.
        USING *,R15
        STM   R8,R12,SAVTAB
        ST    R14,SAV14
        USING CPAUSR,R9,R10
        USING STATEIN,R3
        USING USEREIN,R4

CPAUSR BASR R9,0 

        BCTR  R9,R0
        BCTR  R9,R0
        LA    R1,4095
        LA    R10,1(R9,R1)
        DROP  R15
        B     AUSBEG

SAV14 DS F SAVTAB DS 5F

  • ---------------------------------------------------------------------*
  • E X T R N ' S / E N T R I E S
  • ---------------------------------------------------------------------*

AUSBEG EQU * 

        REQM  1          FUER AUSGABEPUFFER
        LTR   R15,R15
        BE    AUSREQOK
        MVC   ERRTEXT,=CL20'USR/BEG/REQM'    
        BAS   R13,UFEHLER
        L     R14,SAV14
        LM    R8,R12,SAVTAB
        BR    R14

AUSREQOK EQU * 

        ST    R1,ADMUPUFF
        XR    R12,R12
        XR    R5,R5
        LR    R5,R1
        MVC   0(22,R5),SENDNK      NACHR.KOPF
        LA    R12,22(R12)
        LA    R5,22(R5)

        CLI   0(R6),C'?'
        BE    AUINFO
        CLC   0(3,R6),=CL3'HC?'
        BE    AUHCWER
        CLC   0(4,R6),=CL4'HC ?'
        BE    AUHCWER
        CLC   0(3,R6),=CL3'HC '
        BE    AUCHDEV
        CLC   0(5,R6),=CL5'FORM?'
        BE    AUFOWER
        CLC   0(6,R6),=CL6'FORM ?'
        BE    AUFOWER
        CLC   0(5,R6),=CL5'FORM '
        BE    AUCHFORM
        CLC   0(3,R6),=CL3'LL '
        BE    AUHCLL
                • AAAAAA

AUNDEV MVC 0(AD0100Q,R5),AD0100 

        LA    R12,AD0100Q(R12)      LEN
        LA    R5,AD0100Q(R5)        DIST
                • AAAAAA
        B     ADMURET
  • ----------------------------------CH DEVICE NAME DES HC ------------*

AUCHDEV EQU * 

        CLI   3(R6),X'40'
        BE    AUNDEV
        TR    3(8,R6),DEVTAB
        MVC   AD0101F(8),STATDEV
        MVC   AD0102F(8),3(R6)
        MVC   STATDEV(8),3(R6)     NAME NEU SETZEN IN STATEIN
        MVC   0(AD0101Q,R5),AD0101
        LA    R12,AD0101Q(R12)      LEN
        LA    R5,AD0101Q(R5)        DIST
        MVC   0(AD0102Q,R5),AD0102
        LA    R12,AD0102Q(R12)      LEN
        LA    R5,AD0102Q(R5)        DIST
        B     ADMURET

AUHCWER EQU * 

        MVC   AD0103F(8),STATDEV
        MVC   0(AD0103Q,R5),AD0103
        LA    R12,AD0103Q(R12)      LEN
        LA    R5,AD0103Q(R5)        DIST
        B     ADMURET
  • ----------------------------------CH FORMULAR DES HC ------------*

AUCHFORM EQU * 

        CLI   5(R6),X'40'
        BE    AUNDEV
        TR    5(8,R6),DEVTAB
        MVC   AD0104F(8),STATFORM
        MVC   AD0105F(8),5(R6)
        MVC   STATFORM(8),5(R6)     FORM NEU SETZEN IN STATEIN
        MVC   0(AD0104Q,R5),AD0104
        LA    R12,AD0104Q(R12)      LEN
        LA    R5,AD0104Q(R5)        DIST
        MVC   0(AD0105Q,R5),AD0105
        LA    R12,AD0105Q(R12)      LEN
        LA    R5,AD0105Q(R5)        DIST
        B     ADMURET

AUFOWER EQU * 

        MVC   AD0106F(8),STATFORM
        MVC   0(AD0106Q,R5),AD0106
        LA    R12,AD0106Q(R12)      LEN
        LA    R5,AD0106Q(R5)        DIST
        B     ADMURET

AUHCLL EQU * 

        CLI   3(R6),X'40'
        BE    AUNDEV
        CLI   3(R6),C'P'      80 ?
        BNE   AUHCLL1
        MVC   AD0108F(2),=C'80'
        B     AUHCLL2

AUHCLL1 MVC AD0108F(2),=C'82' AUHCLL2 MVC STATHCTY(1),3(R6) LEN NEU SETZEN IN STATEIN 

        MVC   0(AD0108Q,R5),AD0108
        LA    R12,AD0108Q(R12)      LEN
        LA    R5,AD0108Q(R5)        DIST
        B     ADMURET
  • ---------------------------------- ALLGEMEINE INFOS ------------*

AUINFO EQU * 

        MVC   AD0107P(8),STATPRO
        MVC   AD0107S(8),STATPNA
        MVC   0(AD0107Q,R5),AD0107
        LA    R12,AD0107Q(R12)      LEN
        LA    R5,AD0107Q(R5)        DIST
        B     ADMURET

ADMURET EQU * 

        MVC   0(8,R5),SENDEND     ENDE
        LA    R12,8(R12)
        L     R5,ADMUPUFF
        BAS   R13,ADMUSEND
        L     R5,ADMUPUFF
        SRA   R5,12
        LTR   R5,R5
        BNZ   ARELM1
        MVC   ERRTEXT,=CL20'USR/BEG/REL/0'   
        BAS   R13,UFEHLER
        B     ARELMNOK

ARELM1 EQU * 

        RELM  1,(R5)        PUFFER WIEDER FREI

ARELMNOK EQU * 

        L     R14,SAV14
        LM    R8,R12,SAVTAB
        BR    R14
  • ------------------ YSEND --> R5 AREA / R12 --> AREALN --------------*
  • ANSPRING IMMER MIT R13 *
        DS    F

ADMUSEND ST R13,ADMUSEND-4 

        L     R13,STATRPBA
        L     R7,STATCID
        LA    R2,STATEI

AUSEND1 L R14,STAIDCP 

        YSEND RPB=(R13),CID=(R7),AID=(R14),AREA=(R5),AREALN=(R12),    -
              EID=(R2)
        CLM   R15,B'1001',=X'0000'
        BE    ADUENDE
        MVC   ERRTEXT,=CL20'USR/SEND/YSEND'
        CLM   R15,B'1110',=X'10040C'
        BNE   AU777
        SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10
        CLM   R15,B'0001',=X'00'
        BE    AUSEND1
        MVC   ERRTEXT,=CL20'USR/SEND/SOLSIG'

AU777 BAS R13,UFEHLER ADUENDE L R13,ADMUSEND-4 

        BR    R13
  • ----------------------------------------------------------------------*
        DS    F

UFEHLER EQU * 

        ST    R13,UFEHLER-4
        ST    R15,ERR15
        UNPK  ERRR15,ERR15(5)
        TR    ERRR15,HX-240
        WROUT ERRMSG,UTERME

UTERME L R13,UFEHLER-4 

        BR    R13
  • ----------------------------------------------------------------------*

ADMUPUFF DS F AUSGABEPUFFER ERRMSG DC Y(ERRMSGE-ERRMSG) 

        DC    C'   %  ZCP0006 CP-ERROR AT:'

ERRTEXT DS CL20 

        DC    C'  RC:'

ERRR15 DS L9 ERRMSGE EQU *-1 

        ORG
        DS    0F

HX DC C'0123456789ABCDEF' ERR15 DS F UERR15 DS 0L9 

        DS    L4

DMSERR DS L4 

        DS    L1

AD0100 DS 0H 

        DC    C'% ZCP0100 INPUT INVALID. PROCESSING TERMINATED.'
        DC    X'2798'

AD0100E EQU *

AD0101 DS 0H 

        DC    C'% ZCP0101 OLD DEVICE NAME:

AD0101F DS CL8 

        DC    C'
        DC    X'2798'

AD0101E EQU *

AD0102 DS 0H 

        DC    C'% ZCP0102 NEW DEVICE NAME:

AD0102F DS CL8 

        DC    C'
        DC    X'2798'

AD0102E EQU *

AD0103 DS 0H 

        DC    C'% ZCP0103 ACTUAL DEVICE NAME FOR HARDCOPY:

AD0103F DS CL8 

        DC    C'
        DC    X'2798'

AD0103E EQU *

AD0104 DS 0H 

        DC    C'% ZCP0104 OLD FORMULAR NAME:

AD0104F DS CL8 

        DC    C'
        DC    X'2798'

AD0104E EQU * AD0105 DS 0H 

        DC    C'% ZCP0105 NEW FORMULAR NAME:

AD0105F DS CL8 

        DC    C'
        DC    X'2798'

AD0105E EQU *

  • ----------------------------------------------------------------------*

AD0106 DS 0H 

        DC    C'% ZCP0106 ACTUAL FORMULAR NAME FOR HARDCOPY:

AD0106F DS CL8 

        DC    C'
        DC    X'2798'

AD0106E EQU *

AD0108 DS 0H 

        DC    C'% ZCP0108 LINE LENGTH FOR HARDCOPY:

AD0108F DS CL2 

        DC    C'
        DC    X'2798'

AD0108E EQU *

AD0107 DS 0H 

        DC    C'                                     '
        DC    X'2798'
        DC    C'           C P  -  I N F O           '
        DC    X'2798'
        DC    C'                                     '
        DC    X'2798'
        DC    C'           PROCESSOR:       '

AD0107P DS CL8 

        DC    C' '
        DC    X'2798'
        DC    C'           STATION:         '

AD0107S DS CL8 

        DC    C' '
        DC    X'2798'
        DC    C'                                     '
        DC    X'2798'

AD0107E EQU *

SENDNK DS 0CL22 

        DC    X'10401B2061404045625400400000412127822784'  LSP
        DC    X'2798'

SENDEND DS 0CL8 ABSCHLUSS 

        DC    CL4'CMD:'
        DC    X'27841ED7'

        DS    0F

AD0100Q EQU AD0100E-AD0100 AD0101Q EQU AD0101E-AD0101 AD0102Q EQU AD0102E-AD0102 AD0103Q EQU AD0103E-AD0103 AD0104Q EQU AD0104E-AD0104 AD0105Q EQU AD0105E-AD0105 AD0106Q EQU AD0106E-AD0106 AD0107Q EQU AD0107E-AD0107 AD0108Q EQU AD0108E-AD0108 

        DS    0F

DEVTAB DC X'400102030405060708090A0B0C0D0E0F' 

        DC    X'101112131415161718191A1B1C1D1E1F'
        DC    X'202122232425262728292A2B2C2D2E2F'
        DC    X'303132333435363738393A3B3C3D3E3F'
        DC    X'404142434445464748494A4B4C4D4E4F'
        DC    X'505152535455565758595A5B5C5D5E5F'
        DC    X'606162636465666768696A6B6C6D6E6F'
        DC    X'707172737475767778797A7B7C7D7E7F'
        DC    X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F'
        DC    X'90D1D2D3D4D5D6D7D8D9DA9B9C9D9E9F'
        DC    X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF'
        DC    X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'
        DC    X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'
        DC    X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'
        DC    X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'
        DC    X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'
        DS    0F
  • ---------------------------------------------------------------------*
        LTORG              <<<<<<<<<<<<<<<<<
  • ---------------------------------------------------------------------*
  • D S E C T ' S
  • ---------------------------------------------------------------------*
        STATEIN
        EJECT
        USEREIN
  • ---------------------------------------------------------------------*
        END
Von «https://wiki.zweiernet.ch/mediawiki/index.php?title=Cpauser&oldid=316»