Sample DC/UCF Online Program › Input to the DML Precompiler

Input to the DML Precompiler

The following illustrates a sample online program as input to the DML precompiler.

*RETRIEVAL
*DMLIST
*NO-ACTIVITY-LOG
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
         SPACE 1


*                                    ENTER FROM NEXT HIGHER LEVEL
         SPACE 1
         PRINT GEN                   ASSEMBLER PRINT OPTIONS
SYBPG2   CSECT
         LR    R12,R15               ESTABLISHES REGISTER 12 AS THE
         USING SYBPG2,R12             BASE REGISTER
         USING STORAGE,R10           ESTABLISH ADDRESSABILITY OF DSECT
         B     PROCESS               BRANCH TO FIND INVOKING TASKCODE
         EJECT
         @INVOKE MODE=IDMSDC,MAP=SYBMAP
*                                    OPERATING MODE: IDMS DC/MAPPING
         EJECT
         SPACE 1
RETURN   DS    0H
         #FREESTG STGID='SYB4'       FREE THE STORAGE ACQUIRED EARLIER
         #RETURN                     RETURN TO HIGHER LEVEL
         SPACE 1
RETURNXT DS    0H
         #RETURN NXTTASK=SYBTSK03    PASS CONTROL BACK TO ITSELF
         SPACE 1
*                                    MAINLINE PROGRAM
         SPACE 1
PROCESS  DS    0H
         #GETSTG TYPE=(USER,LONG,KEEP),PLIST=*,LEN=STORLGTH,           *
               STGID='SYB4',COND=(ALL),ERROR=ERRORTN,ADDR=(R10),       *
               INIT=X'40'
*                                    ACQUIRE VARIABLE STORAGE
         SPACE 1
         #MAPBIND MRB=SYBMAP         BIND MAP AND RECORDS
         #MAPBIND MRB=SYBMAP,RECNAME=SYBREC
         SPACE 1
ACCEPTSK #ACCEPT TYPE=TASKCODE,FIELD=TASKCODE
*                                    ACCEPT TASK CODE TO INVOKE TASK
         CLC   TASKCODE,SYBTSK2      FIRST TIME CALLED ?
         BNE   RECCUR                YES - OUTPUT FIRST SCREEN
*                                    NO  - INPUT DATA FROM SCREEN
FIRSTIME DS    0H
         MVC   SYBDEPID,=C'0000'     PRIME DATA FIELD
         SPACE
         #MREQ OUT,MRB=SYBMAP,OPTNS=(NEWPAGE),ERROR=ERRORTN,           *


               COND=(ALL)
*                                    MAP OUT PROMPT
         SPACE
         B     RETURNXT              EXIT & WAIT FOR OPERATOR RESPONSE
         SPACE 2
RECCUR   DS    0H
         #MREQ IN,MRB=SYBMAP,ERROR=ERRORTN,COND=(ALL)
*                                    MAP IN TERMINAL INPUT
         SPACE 1
         #MAPINQ MRB=SYBMAP,AID=AIDBYTE
*                                    MOVE MAP DATA TO PROG VARIABLE STG
         CLI   AIDBYTE,CLEAR         DID THE OPERATOR REQUEST FINISH?
         BE    RETURN                YES - EXIT PGM, BACK TO IDMS DC
         SPACE
         #MREQ OUT,MRB=SYBMAP,ERROR=ERRORTN,                           *
               COND=(ALL)
*                                    MAP OUT DATA
         SPACE
         B     RETURNXT              EXIT & WAIT FOR OPERATOR RESPONSE
*                                    NO  - MAPOUT, WAIT ON OPERATOR
ERRORTN  DS    0H                    HERE FOR NONZERO RETURN CODE
         #SNAP AREA=(SYBMAP,SYBMAPLN)
         B     RETURN                EXIT
CLEAR    EQU   X'6D'                 CLEAR AIDBYTE VALUE
SYBTSK2  DC    CL8'SYBTSK2 '         DC TASK INVOKING VALUE (EXTERNAL)
SYBTSK03 DC    CL8'SYBTSK03'         DC TASK INVOKING VALUE (INTERNAL)
         LTORG
         #BALI
         SPACE 2
********************************************************************
STORAGE  DSECT                       STORAGE DSECT
         @COPY IDMS,MAP-CONTROL=SYBMAP
SYBMAPLN EQU   *-SYBMAP              LENGTH OF #MRB FOR SNAP
         SPACE 1
         @COPY IDMS,MAP-RECORDS
         SPACE 1
SYSPLIST DS    20F                   MAP OUT PARAMETER LIST AREA
TASKCODE DS    CL8                   TASK CODE WHICH INVOKED PROGRAM
AIDBYTE  DS    X                     ATTENTION IDENTIFIER BYTE
         DS    3X                    RESERVED
STORLGTH EQU   *-STORAGE             TOTAL LENGTH OF STORAGE NEEDED
         SPACE 1
         END   SYBPG2