*DECK C$OMM 
          IDENT  C$OMM
 CBOMM    TITLE  CBOMM - COBOL5 OBJECT TIME CMM INTERFACE 
          MACHINE  ANY,I
  
          COMMENT  MEMORY MANAGER INTERFACE 
          B1=1
          SST 
  
 CBOMM    SPACE  4
**        CBOMM - OBJECT TIME CRM MEMORY MANAGER INTERFACE
* 
*                WILL INTERFACE TO CMM FIXED BLOCKS ONLY - IF 
*                   OTHER PRODUCE SETS INTERFACE TO VARYING,
*                   THIS WILL BE CHANGED TO DO THE SAME.
* 
*                THIS INTERFACE SUPPORTS TWO TYPES OF CMM BLOCKS: 
*                            FIXED LENGTH 
*                            VARYING LENGTH ( AT LWA END) 
* 
*                POINTER WORDS MUST BE IN FIXED LOCATIONS AND ARE 
*                            MAINTAINED IN CMM STANDARD FORMAT; 
*                            AN ALTERNATE FORMAT IS AVAILABLE FOR 
*                            FIXED LENGTH BLOCKS HOWEVER. 
* 
* 
*         ENTRY POINTS: 
  
          ENTRY  C.GETBK
          ENTRY  C.FREBK
          ENTRY  C.GROWB
          ENTRY  C.SHBLK
  
*         EXTERNAL REFS:  
  
*         EXT    CRM MEMORY MANAGER 
          EXT    C.MSG       PUTS OUT ERROR MSGS
  
  
 C.GETBK  TITLE  C.GETBK - GET A BLOCK OF STORAGE 
**        C.GETBK - GET A BLOCK OF STORAGE
*                            BLOCK MAY BE EITHER FIXED OR VARYING 
*                            LENGTH, BUT ALL BLOCKS ARE VARYING POSITION
*                            IF FIXED LENGTH, THEY MAY HAE EITHER A CMM 
*                            FORMAT POINTER OR AN ALT. FORMAT POINTER.
* 
*                POINTER FORMATS: 
*                CMM -       VFD   30/LENGTH,30/ADDR
*                ALT -       VFD   42/USER INFO,18/ADDR 
* 
*         CALLING SEQ:  
* 
*         SB5    POINTER ADDR 
*         SB6    INITIAL BLOCK LENGTH 
*         SB7    0 - FIXED LENGTH, CMM POINTER
*                1 - FIXED LENGTH, ALT. POINTER 
*                2 - VARYING LENGTH, CMM POINTER
*         RJ     =XC.GETBK
* 
*         RETURNS:  
*                POINTER SET UP AND READY TO USE
* 
*         USES- 
*                X  - 1 2 3 4 5 6 7   THESE USED MAINLY BY CMM
*                A  - 1 2 3 4 5 6 7 
*                B  - - - - 4 5 6 7 
* 
* 
  
 C.GETBK  DATA   0
          SX6    B5 
          SA6    PTR
          SB5    B1+B1
          LT     B5,B7,ERR2  BAD PARAM
          SX6    B6 
          SA6    A6+B1       BLOCK SIZE 
          SX7    B7+0 
          SA7    A6+B1       TYPE 
  
          SX2    B6 
          MX3    0
          RJ     =XCMM.ALF   ALLOCATE A FIXED BLOCK 
          SA2    PTR         GET ADDR OF POINTER WORD 
          SB5    X2 
          SA2    A2+B1       SIZE 
          SA5    A2+B1       GET TYPE 
          SX6    X5-1 
          NZ     X6,GETBK2
  
          SX6    X1          ADDRESS
          SA6    B5+0 
          EQ     C.GETBK     RETURN 
  
 GETBK2   BSS    0
          LX2    30          POSITION SIZE
          SX6    X1          ADDR 
          BX6    X2+X6
          SA6    B5          PUT IN POINTER 
          EQ     C.GETBK     RETURN 
  
  
 C.FREBK  TITLE  C.FREBK - FREE A BLOCK OF STORAGE
**        C.FREBK - FREE A BLOCK OF STORAGE 
*                DE-ALLOCATES THE BLOCK, PLACING THE CORE BACK IN 
*                CMMS POOL AND ZEROS THE POINTER
* 
*         CALLING SEQ:  
* 
*         SB7    POINTER ADDR 
*         RJ     =XC.FREBK
* 
*         SAVES - A0,X0,B2,B3,X5
  
 C.FREBK  DATA   0
          SA1    B7          GET POINTER WORD   410=          RJ     =XC
          MX7    0
          SA7    B7          CLEAR POINTER
          SX1    X1          ADDRESS OF BLOCK 
          RJ     =XCMM.FRF   FREE THE BLOCK 
          EQ     C.FREBK     EXIT 
  
 C.SHBLK  TITLE  C.SHBLK - SHRINK BLOCK AT LWA END
**        C.SHBLK - SHRINK BLOCK AT LWA END 
* 
*                THIS ROUTINE IS CURRENTLY JUST A DUMMY, DECREMENTING 
*                            THE LENGTH IN THE POINTER AND RETURNING. 
* 
*         USES: 
*                X  - 1 - - - - - 7 
*                A  - 1 - - - - - 7 
*                B  - - - - - - 6 7    EXPECTS B1=1 
* 
* 
 C.SHBLK  DATA   0
          SX7    B7          INCREMENT
          LX7    30 
          SA1    B6          GET POINTER WORD 
          IX7    X1-X7
          SA7    A1 
          EQ     C.SHBLK     EXIT 
  
 C.GROWB  TITLE  C.GROWB - GROW BLOCK AT LWA END
**        C.GROWB - GROW BLOCK AT LWA END 
* 
*                IN ALL CASES, WE GET A NEW BLOCK FROM CMM AND
*                COPY THE OLD BLOCK TO THE
*                                  NEW ONE, AND RELEASE THE OLD BLOCK.
* 
*         CALLING SEQ:  
*         SB6    POINTER ADDR 
*         SB7    INCREMENT SIZE 
*         RJ     =XC.GROWB
* 
*         USES: 
*                X  0 1 - 3 4 5 - 7 
*                A  - 1 - 3 4 5 - 7 
*                B  - - 2 3 4 5 6 7    EXPECTS B1=1 
* 
* 
 C.GROWB  DATA   0
          SA1    B6          GET POINTER
          SX6    B6 
          SA6    PTR         SAVE POINTER 
          AX1    30          OLD SIXE 
          SX7    X1+B7       NEW SIZE 
          SA7    A6+B1       SAVE NEW SIZE
          SX2    X7          BLOCK SIZE 
          MX3    0
          RJ     =XCMM.ALF   GET NEW BLOCK
          SA2    PTR         GET POINTER
          SA3    A2+B1       GET NEW SIZE 
          SA4    X2          GET ACTUAL OLD POINTER 
          SX6    X1          ADDR OF NEW BLOCK
          LX3    30 
          BX6    X6+X3
          SA6    A4          STORE NEW POINTER
          SB5    X4          ADDR OF OLD BLOCK
          LX4    30 
          SB7    X4          SIZE OF OLD BLOCK
          SB4    X1          ADDR OF NEW BLOCK
 GROWB4   BSS    0
          SA1    B5          MOVE OLD TO NEW BLOCK
          SB7    B7-B1
          SB5    B5+B1
          BX6    X1 
          SA6    B4 
          SB4    B4+B1
          NZ     B7,GROWB4
          LX4    30 
          SX1    X4          ADDR OF OLD BLOCK
          RJ     =XCMM.FRF   FREE THE BLOCK 
          EQ     C.GROWB     RETURN 
  
  
 ERRORS   TITLE  HANDLE ERRORS
* 
*         COMMON ERROR EXITS -
*                PUT ERROR NUMBER IN X1 AND JUMP TO ERROR 
* 
  
 ERR2     SX1    #MMERR2     BAD BLOCK TYPE 
          EQ     ERROR
  
 ERROR    MX2    0           NO INSERTIONS
          SX3    -1          UNKNOWN LINE NR
          SX6    B1          ABORT
          RJ     =XC.MSG
  
 FINDBK   TITLE  FINDBK - FIND A BLOCK POINTER
  
 PTR      BSSZ   3           PTR/SIZE/TYPE
          END 
