*DECK DBP$00
          IDENT  DBP$00 
 DBP$00   TITLE  DATABASE PROCEDURE INTERFACE FOR THE (0,0) OVERLAY 
          COMMENT  DATABASE PROCEDURE INTERFACE FOR (0,0) OVERLAY 
          SPACE  3
**        PRELINK - ESTABLISH DBP LINKAGE ROUTINES
* 
*              THIS MACRO CREATES A SMALL ROUTINE FOR EACH OCCURENCE
*         OF THE MACRO. EACH ROUTINE IS MADE AN ENTRY POINT, AND HAS
*         A RIGHT JUSTIFIED *RJ* INSTRUCTION AT EP+1 WHICH THE *LINK* 
*         MACRO IN DBP$X0 MODIFIES. EP+2 CONTAINS THE RETURN, AND EP+3
*         CONTAINS THE NAME THIS ROUTINE *LINKS* TO.
* 
*         ENTRY  EP - ENTRY POINT NAME
*                NAME - NAME OF THE ROUTINE THIS EP LINKS TO
* 
*         EXIT   LINKAGE ROUTINE CREATED
*                EP MADE AN ENTRY POINT 
  
  
  
          PURGMAC  PRELINK
  
  
  
 PRELINK  MACRO  EP,NAME
          ENTRY  EP 
 EP       SUBR                     ENTRY/EXIT 
          SB0    -1                30 BIT NO-OP THAT IS RECOGNIZABLE
          RJ     *+1S17            ADDRESS WILL BE ALTERED BY DBP$X0
          EQ     EXIT.
  
          DATA   10H_NAME          NAME OF ROUTINE *EP* LINKS TO
          ENDM
  
  
  
* THE PRELINK MACRO CORRESPONDS TO THE LINK MACRO IN DBP$X0. THEY BOTH
* SET UP FOR THE -RJ- ADDRESS TO BE RIGHT JUSTIFIED IN EP+1.
          PRELINK  Q$OPEN,OPENM 
          PRELINK  Q$CLOSE,CLOSEM 
          PRELINK  Q$GET,GET
          PRELINK  Q$GETN,GETN
          PRELINK  Q$PUT,PUT
          PRELINK  Q$DLTE,DLTE
          PRELINK  Q$REPLC,REPLC
          PRELINK  Q$FIS,FILEIS 
          PRELINK  Q$FSQ,FILESQ 
          PRELINK  Q$FDA,FILEDA 
          PRELINK  Q$FAK,FILEAK 
          PRELINK  Q$FETCH,IFETCH 
          PRELINK  Q$START,STARTM 
          PRELINK  Q$STORE,STOREF 
          PRELINK  Q$REWND,REWND
          EJECT 
 DBP$CAL  TITLE  DATABASE PROCEDURE CALLING ROUTINE 
          EJECT 
***       DBP$CAL            DATA BASE PROCEDURE CALLING ROUTINE
* 
*         ENTRY              (A1) = FWA OF PARAMETER LIST 
* 
*         EXIT               DATA BASE PROCEDURE WAS EXECUTED 
* 
*         CALLING SEQUENCE - DBP$CAL(ADDR,P1,P2,P3,P4,...)
* 
*                          ..ADDR IS AN INTEGER PARAMETER WHOSE VALUE IS
*                            THE ENTRY POINT ADDRESS TO WHICH WE -RJ-.
* 
*                          ..P1-PN  ARE THE PARAMETERS TO BE PASSED TO
*                            THE CALLED ENTRY POINT.
* 
*         THIS ROUTINE CALLS QU$EXIT IF IT IS LOADED, OTHERWISE JP*S TO 
*         PROC+1 AFTER STORING A RETURN TO OUR CALLER AT PROC+0. CARE 
*         MUST BE TAKEN TO INSURE THAT A1 IS ADVANCED TO POINT TO P1
*         INSTEAD OF ADDR, AND NOT USED BEFORE THE PROC IS CALLED.
  
  
  
          ENTRY  DBP$CAL
          ENTRY  DBP$EXT
  
 DBP$EXT  DATA   0                 EITHER 0 OR *RJ QUEXIT*
  
 DBP$CAL  JP     *+1S17 
          SA3    DBP$EXT
          NZ     X3,DBP$EXT        IF QU$EXIT IS LOADED 
          SA2    X1                (X2) = ADDRESS OF DATABASE PROC
          SA1    A1+1              (A1) = POINTER TO PARAMETER P1,P2,...
          SB6    X2                (B6) = EP ADDR OF DBP
          SA3    DBP$CAL           STORE RETURN LINK FOR DBP
          BX6    X3 
          SA6    B6 
          RJ     CLR.INS           CLEAR INSTRUCTION STACK
 CLR.INS  DATA   0
          JP     B6+1              BEGIN EXECUTION OF DBP AT EP+1 
  
          SPACE  4,8
          EJECT 
***       Q$CONF - FLOATING TO INTEGER CONVERSION 
* 
*              THIS ROUTINE ACCEPTS A LIST OF FLOATING POINT NUMBERS AS 
*         INPUT AND REPLACES EACH WITH ITS INTEGER EQUIVALENT. THE LIST 
*         IS A STANDARD FTN/COBOL PARAMETER LIST TERMINATED BY A ZERO 
*         ADDRESS.
* 
*         ENTRY  (A1) = FWA OF PARAMETER LIST 
* 
*         EXIT   (B1) = 1 
* 
*         CALLS  NONE 
* 
*         USES   A - 1, 2, 7
*                B - 1, 2 
*                X - 1, 2, 7
  
  
  
          ENTRY  Q$CONF 
 Q$CONF   SUBR                     ENTRY/EXIT 
          SB1    1
          SA2    A1                (X2) = ADDR OF FIRST PARAMETER 
 Q$CONF1  ZR     X2,EXIT.          IF END OF PARAMETER LIST 
          SA1    X2                (X1) = FLOATING POINT NUMBER 
          UX7    X1,B2             (X7) = UNPACKED FLOATING POINT 
          LX7    B2                (X7) = SCALED, UNPACKED FLOATING PT
          SA7    A1                (X7) = EQUIVALENT INTEGER NUMBER 
          SA2    A2+B1             (X2) = ADDR OF NEXT PARAMETER
          EQ     Q$CONF1
          SPACE  4,8
          EJECT 
***       Q$CIN1 - INTEGER TO COMP-1 CONVERSION 
* 
*              THIS ROUTINE ACCEPTS A LIST OF INTEGERS AS INPUT AND 
*         REPLACES EACH WITH ITS COMP-1 (UN-NORMALIZED FLOATING PT) 
*         EQUIVALENT. THE LIST IS A STANDARD FTN/COBOL PARAMETER LIST 
*         TERMINATED BY A ZERO ADDRESS. 
* 
*         ENTRY  (A1) = FWA OF PARAMETER LIST 
* 
*         EXIT   (B1) = 1 
* 
*         CALLS  NONE 
* 
*         USES   A - 1, 2, 7
*                B - 1
*                X - 1, 2, 7
  
  
  
          ENTRY  Q$CIN1 
 Q$CIN1   SUBR                     ENTRY/EXIT 
          SB1    1
          SA2    A1                (X2) = ADDR OF FIRST PARAMETER 
 Q$CIN1L  ZR     X2,EXIT.          IF END OF PARAMETER LIST 
          SA1    X2                (X1) = INTEGER NUMBER
          PX7    X1                (X7) = PACKED INTEGER
          SA7    A1                (X7) = UN-NORMALIZED FLOATING PT 
          SA2    A2+B1             (X2) = ADDR OF NEXT PARAMETER
          EQ     Q$CIN1L
          SPACE  4,8
          EJECT 
***       Q$CIN2 - INTEGER TO COMP-2 CONVERSION 
* 
*              THIS ROUTINE ACCEPTS A LIST OF INTEGERS AS INPUT AND 
*         REPLACES EACH WITH ITS COMP-2 (NORMALIZED FLOATING PT)
*         EQUIVALENT. THE LIST IS A STANDARD FTN/COBOL PARAMETER LIST 
*         TERMINATED BY A ZERO ADDRESS. 
* 
*         ENTRY  (A1) = FWA OF PARAMETER LIST 
* 
*         EXIT   (B1) = 1 
* 
*         CALLS  NONE 
* 
*         USES   A - 1, 2, 7
*                B - 1
*                X - 1, 2, 7
  
  
  
          ENTRY  Q$CIN2 
 Q$CIN2   SUBR                     ENTRY/EXIT 
          SB1    1
          SA2    A1                (X2) = ADDRESS OF FIRST PARAMETER
 Q$CIN2L  ZR     X2,EXIT.          IF END OF PARAMETER LIST 
          SA1    X2                (X1) = INTEGER NUMBER
          PX7    X1                (X7) = PACKED INTEGER
          NX7    X7                (X7) = NORMALIZED PACKED INTEGER 
          SA7    A1                (X7) = NORMALIZED FLOATING PT
          SA2    A2+B1             (X2) = ADDR OF NEXT PARAMETER
          EQ     Q$CIN2L
          SPACE  4
          EJECT 
**        Q$READ - DBP INTERFACE TO *READ*
* 
*              THIS ROUTINE IS PASSED A CALL FROM A DBP THAT LOOKS LIKE 
*                  *QUREAD(WSA, LENGTH)*
*         THIS CALL MUST BE CHANGED TO A CALL LIKE
*                  *READ(WSA, LENGTH, LIMIT, RC)* 
*         THIS IS DONE BY USING A LOCAL PARAMETER LIST, INSERTING THE 
*         CALLERS ADDRESSES, AND CALLING *READ* WITH THE LOCAL PARAM
*         STRING. 
* 
*         ENTRY  (A1) = FWA OF PARAM LIST 
*                (X1) = ADDR OF WSA 
* 
*         EXIT   NONE 
* 
*         CALLS  READ 
  
  
  
          ENTRY  Q$READ 
 Q$READ   SUBR                     ENTRY/EXIT 
          SB1    1
          BX6    X1                (X6) = ADDR OF WSA 
          SA2    A1+B1
          BX7    X2                (X7) = ADDR OF LENGTH PARAM
          SA6    Q$READA
          SA7    A6+B1
          SA1    A6                (A1) = FWA OF PARAM LIST TO *READ* 
          RJ     =XREAD 
          SA1    Q$READA+1         (X1) = ADDR OF LENGTH PARAM (INT)
          SA2    X1 
          PX7    X2 
          NX7    X7 
          SA7    A2                REPLACE WITH COMP-2 LENGTH 
          EQ     EXIT.
  
  
 Q$READA  VFD    60/0              ADDR OF WSA
          VFD    60/0              ADDR OF LENGTH PARAM 
          VFD    60/=XMXTRNLG      ADDR OF LIMIT PARAM
          VFD    60/=XDUMMY        ADDR OF RC PARAM 
          SPACE  4
          EJECT 
**        Q$WRITE - DBP INTERFACE TO *WRITE*
* 
*              THIS ROUTINE IS PASSED A CALL FROM A DBP THAT LOOKS LIKE 
*                  *QUWRITE(WSA, LENGTH)* 
*         THIS CALL MUST BE CHANGED TO A CALL LIKE
*                  *WRITE(WSA, LENGTH, RC)* 
*         THIS IS DONE BY USING A LOCAL PARAMETER LIST, INSERTING THE 
*         CALLERS ADDRESSES, AND CALLING *WRITE* WITH THE LOCAL PARAM 
*         STRING. 
* 
*         ENTRY  (A1) = FWA OF PARAM LIST 
*                (X1) = ADDR OF WSA 
* 
*         EXIT   NONE 
* 
*         CALLS  WRITE
  
  
  
          ENTRY  Q$WRITE
 Q$WRITE  SUBR                     ENTRY/EXIT 
          SB1    1
          BX6    X1                (X6) = ADDR OF WSA 
          SA2    A1+B1
          SA6    Q$WRITEA 
          SA1    X2                (X1) = LENGTH PARAM (COMP-2) 
          UX7    X1,B2
          LX7    B2 
          SA7    Q$WRITEB          STORE AS INTEGER LENGTH PARAM
          SA1    A6                (A1) = FWA OF PARAM LIST TO *WRITE*
          RJ     =XWRITE
          EQ     EXIT.
  
  
 Q$WRITEA VFD    60/0              ADDR OF WSA
          VFD    60/Q$WRITEB       ADDR OF INTEGER LENGTH PARAM 
          VFD    60/=XDUMMY        ADDR OF RC PARAM 
  
 Q$WRITEB DATA   0                 INTEGER LENGTH FOR WRITING 
  
  
          END 
