         TITLE     'IFDBM: OPENRET1,OPENUPD1,CREATE1,CLOSARE1'
         SYSTEM    FORTLIB
         SYSTEM    SIG7
         SYSTEM    BPM
         REF       FINDFRST,FINDLAST
         REF       9SETUPN,M:DO,OPENRET,CLOSAREA,CREATE,OPENUPD
         REF       OPRETSHD,OPUPDSHD
         REF       FINDG,GET,FINDDUP,FINDC,FINDM,HEAD
         REF       FINDN,FINDP,STORE
         DEF       FINDG1,GET1,FINDDUP1,FINDC1
         DEF       OPENRET1,CLOSARE1,CREATE1,OPENUPD1
         DEF       OPRETSH1,OPUPDSH1
         DEF       FINDN1,FINDP1,STORE1,FINDM1,HEAD1
         DEF       FINDFRS1,FINDLAS1
*
*       FORTRAN CALLABLE DBM DUMMIES THAT ARE WRITTEN
*           IN METASYMBOL.
*            THESE HAVE 3 OR 4 ARGUMENTS, AND ARE THE ONES
*           THAT MAY HAVE ITEM ADDRESSES, WHICH MUST BE
*           WA OR BA DEPENDING ON TYPE.
*
*       DATE OF LAST CHANGE:  4/19/71   RWS
*          (ADDITION OF FINDX1)
*
*
*      MODIFY1, GET2   - FORTRAN CALLABLE ROUTINES TO DO
*        DMS MODIFY AND GET CALLS
*
*        THESE TWO ROUTINES ARE NECESSARY FOR TWO REASONS:
*        ARGS TO THESE 2 DMS ROUTINES MUST BE COMPUTED AT
*        EXECUTION TIME IN OUR APPLICATION, AND THEY HAVE
*        VARIABLE NUMBER OF ARGUMENTS - BOTH OF WHICH ARE
*        DIFFICULT TO HANDLE IN FORTRAN.
*
*        CALLING SEQUENCE:  CALL GET2(ICCB,IOFFS,KOUNT)
*                        (OR MODIFY1)
*
*        WHERE ICCB  IS AN ARRAY WHICH CONTAINS THE
*                     DMS WORKING STORAGE AREA
*              IOFFS IS THE ARRAY   WHERE THE WORKING
*                  STORAGE OFFSETS FOR THE GRP AND ITEM NAMES
*                    ARE STORED (STARTING IN WORD 1)
*                   (RESOLUTION OF OFFSETS ASSUMED BYTE -
*                  AND IF OFFSET IS THAT OF A BIN, FLPTL, OR
*                  FLPTS ITEM, THE LEFTMOST (ZERO) BIT WILL BE
*                  SET TO ONE, TO INDICATE THAT IT SHOULD BE
*                  CONVERTED TO WORD RESOLUTION)..
*         AND KOUNT IS THE NUMBER OF ARGUMENTS, INCLUDING
*                  THE GROUP NAME.
*
*
*             IF KOUNT IS LESS THAN ONE OR MORE THAN NMGARGS,
*         ROUTINE PRINTS ERR MSG (ON M:DO), AND RETURNS
*               WITHOUT CALLING GET OR MODIFY.
*
*
*        ROUTINE IS NOT REENTRANT
*
*     MONITOR SERVICES USED: M:WRITE FOR ERR MSG
*
*  ASSEMBLY PARAMETERS:
NMGARGS  EQU       20           MAX NUMBER OF GET OR MOD ARGS
*
MG       CSECT     0
         PAGE
FINDM1   LW,7      MBAL33
         B         OPENRET1+1
HEAD1    LW,7      MBAL34
         B         OPENRET1+1
FINDFRS1 LW,7      MBAL15
         B         OPENRET1+1
FINDLAS1 LW,7      MBAL16
         B         OPENRET1+1
*
FINDN1    LW,7     MBAL23
          B        OPENRET1+1
FINDP1    LW,7     MBAL24
          B        OPENRET1+1
STORE1   LW,7      MBAL22
         B         OPENRET1+1
FINDG1   LW,7      MBAL13
         B         OPENRET1+1
GET1     LW,7      MBAL17
         B         OPENRET1+1
FINDC1   LW,7      MBAL12
         B         OPENRET1+1
FINDDUP1 LW,7      MBAL14
         B         OPENRET1+1
*
CREATE1  LW,7      MBAL5
         B         OPENRET1+1
OPENUPD1 LW,7      MBAL1
         B         OPENRET1+1
CLOSARE1 LW,7      MBAL6
         B         OPENRET1+1
OPRETSH1 LW,7      MBAL2
         B         OPENRET1+1
OPUPDSH1 LW,7      MBAL4
         B         OPENRET1+1
OPENRET1 LW,7      MBAL3
         LI,ND     3
         BAL,LR    9SETUPN             SET UP DUMMYS
         INTG      ICCB
         INTG      IOFFS
         INTG      KOUNT
         STW,15    PTMP                SAVE RETURN ADDR
         STW,7     SKEL2               STORE BAL INSTRUCTION
         LW,7      *KOUNT
         CI,7      NMGARGS        IS NUMBER OF ARGS TOO LARGE?
         BG        MGABORT             YES, ABORT
         CI,7      1                   IS IT TOO SMALL?
         BGE        MGOK                NO, CARRY ON
*
MGABORT  M:WRITE   M:DO,(BUF,BADK),(SIZE,12)
         B         *PTMP
*
MGOK     LW,1      ICCB           PICK UP WA OF CCB
         SLS,1     2        SHIFT LEFT 2 TO MAKE BA
         LI,5      0              INIT LOOP INDEX
         LW,7      *KOUNT         SET UP FOR LOOP
LOOP     LW,6      *IOFFS,5       PICK UP WSI
         AND,6      POSMASK         REMOVE WA FLAG, IF ANY
         AW,6      1             ADD ON BA(CCB)
         LW,4      *IOFFS,5
         BGEZ      %+2            IS IT A BIN OR FP ITEM
         SLS,6     -2               YES, CONVERT TO WA
         AND,6     ADDRMASK       MASK TO ADDRESS PORTION
         STW,6     SKEL3,5         AND STORE IN CALLING SEQ
         AI,5      1              BUMP INDEX
         BDR,7     LOOP           LOOP KOUNT TIMES
         LW,6      EOS            THEN STASH RETURN BRANCH
         STW,6     SKEL3,5
SKEL     LW,14     *KOUNT         AND EXECUTE THE CALL
SKEL2    BAL,15    GET            (OR MODIFY)
SKEL3    RES       NMGARGS+1
*
*
*CONSTANTS AND WORK AREAS
*
BADK     TEXT      '***BAD MG1 K'
POSMASK  DATA      X'7FFFFFFF'       ALL BUT LEFT BIT
ADDRMASK DATA      X'0007FFFF'    MASK FOR BYTE ADDRESS
EOS      B         *PTMP
ICCB    RES       1
IOFFS    RES       1
KOUNT    RES       1
PTMP     RES       1
*
MBAL1    BAL,15    OPENUPD
MBAL2    BAL,15    OPRETSHD
MBAL3    BAL,15    OPENRET
MBAL4    BAL,15    OPUPDSHD
MBAL5    BAL,15    CREATE
MBAL6    BAL,15    CLOSAREA
MBAL12   BAL,15    FINDC
MBAL13   BAL,15    FINDG
MBAL14   BAL,15    FINDDUP
MBAL15   BAL,15    FINDFRST
MBAL16   BAL,15    FINDLAST
MBAL17   BAL,15    GET
MBAL22   BAL,15    STORE
MBAL23   BAL,15    FINDN
MBAL24   BAL,15    FINDP
MBAL33   BAL,15    FINDM
MBAL34   BAL,15    HEAD
         END
