Cpauser: Unterschied zwischen den Versionen

Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
Wechseln zu: Navigation, Suche
(Die Seite wurde neu angelegt: «<syntaxhighlight lang="asm"> * RELM UEBERPRUEFEN AUF GUELTIGKEIT. ** V3.0AK4 * REQM UEBERPRUEFEN AUF GUELTIGKEIT. ** V3.0AK3 * KOMMANDO /LL FUER LINELEN 80 ODE…»)
 
Zeile 1: Zeile 1:
−
<syntaxhighlight lang="asm">
+
<source lang="asm">
  
 
* RELM UEBERPRUEFEN AUF GUELTIGKEIT.
 
* RELM UEBERPRUEFEN AUF GUELTIGKEIT.

Version vom 18. Januar 2016, 21:17 Uhr

* 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
##BAL    OPSYN ##BAS
##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=280»