*DECK DBP$LOD 
USETEXT TAREATB 
USETEXT TCMMDEF 
USETEXT TDBPDEF 
USETEXT TFIT
      PROC DBP$LOD(RC); 
      BEGIN 
#                                                                      #
#      D B P $ L O D                                                   #
#                                                                      #
#     THIS ROUTINE SCANS THE USETABLES AND BUILDS A LIST OF ALL UNIQUE #
#     ENTRY-POINT NAMES NEEDED AS USER-WRITTEN DATA BASE PROCEDURES.   #
#     THIS LIST IS GIVEN TO -DBP$PIL-  WHICH WILL ATTEMPT TO LOAD THEM #
#     WITH A PROGRAM INITIATED LOAD. THE USETABLES ARE SCANNED A SECOND#
#     TIME TO SAVE THE ADDRESSES AT WHICH THE ENTRY POINTS WERE LOADED.#
#     MISSING ENTRY POINTS WILL CAUSE DIAGNOSTICS IDENTIFYING THE MISS-#
#     ING ENTRY POINTS, AND THE RETURN CODE WILL FLAG THE PROBLEM TO   #
#     OUR CALLER. THE ENTRY POINT LIST IS BUILT IN MEMORY ACQUIRED FROM#
#     CMM. THE GROUP-ID OF THIS BLOCK IS SAVED IN DBP$EPLGR. THIS      #
#     SPACE MUST BE RELEASED BEFORE RETURNING.                         #
#   *** NOTE THE FOLLOWING ABBREVIATIONS HAVE BEEN USED IN COMMENTS:   #
#                 EPL  -  ENTRY POINT LIST                             #
#                 EP   -  ENTRY POINT                                  #
#                 SS   -  SUBSCHEMA                                    #
#                 DBP  -  DATA BASE PROCEDURE                          #
  
  
      DEF MAXINDEX # O"1100" #;    # MAXIMUM NUMBER OF EP-S POSSIBLE   #
                                   # IS 1000B. WE ALLOW FOR 1100B JUST #
                                   # IN CASE.                          #
  
      ITEM RC;                     #  0 IF ALL WENT OK                 #
                                   #  1 IF NOT ALL ENTRY POINTS LOADED #
  
      XREF ITEM AREATBLPTR I;      # POINTER TO FIRST AREA TABLE IN    #
                                   # LIST OF AREAS. 0 IF NO AREATABLES #
  
  
      BASED ARRAY DBP$EPL;         # ENTRY POINT LIST FOR DATA-BASE-   #
                                   # PROCEDURES LOAD.                  #
        BEGIN 
        ITEM DBP$EPLWORD I(00,00,60);  # FULL WORD DEFINITION          #
  
        ITEM DBP$EPLNAME C(00,00,07);  # ENTRY POINT NAME              #
  
        ITEM DBP$EPLADDR I(00,42,18);  # ENTRY POINT ADDRESS           #
        END 
  
      ITEM DBP$EPLGR I;            # GROUP-ID FOR EPL CMM-BLOCKS       #
  
      ITEM DBP$LIB I = 0;          #  WILL CONTAIN THE NAME OF LIBRARY #
                                   #  FROM WHICH DBPS SHOULD BE LOAD-  #
                                   #  ED. ZERO IF NOT SPECIFIED IN SS. #
  
      BASED ARRAY DBP$TBL;         # TABLE STRUCTURE FOR DBP NAMES IN  #
                                   # AREA TABLE                        #
        BEGIN 
        ITEM DBP$TBLNAME C(00,00,07);  # DATA BASE PROCEDURE NAME      #
  
        ITEM DBP$TBLADDR I(00,42,18);  # ADDRESS OF DBP - IN DBP$LOD IT#
                                       # IS USED AS INDEX INTO EPL WHEN#
                                       # LOADING - LATER,ADDRESS OF DBP#
  
        ITEM DBP$TBLWORD I(00,00,60);  # FULL WORD DEFINITION          #
        END 
  
      ITEM I;                      # SCRATCH VARIABLE USED IN LOOPS    #
  
      ITEM INDEX I = 0;            #  INDEX INTO DBP$EPL- NEXT EP SLOT #
                                   #  TO BE FILLED. ALSO DOUBLES AS THE#
                                   #  NUMBER OF EPS IN THE LIST SO FAR #
  
      ITEM J;                      # SCRATCH VARIABLE USED IN LOOPS    #
  
      ITEM NEWEP B ;               #  BOOLEAN ITEM. INDICATES WHETHER  #
                                   #  THE EP IN QUESTION IS NEW OR IS  #
                                   #  ALREADY KNOWN IN THE EPL         #
  
      ITEM NEXTTABLE I;            # ADDRESS OF NEXT AREA TABLE IN THE #
                                   # CHAIN. ZERO MEANS END OF LIST.    #
  
      XREF ITEM DBP$FWA I;         # FWA OF BLOCK CONTAINING LOADED DBP#
  
      XREF ITEM DBP$LTL I;         # LOADER TABLE LENGTH               #
  
      XREF PROC DBP$PIL;           # PERFORMS PROGRAM-INITIATED LOAD.  #
                                   # PARAMETER LIST-                   #
                                   #   (EPL, NO.EPS, LIBNAME, FWA)     #
                                   # RETURNS FWA OF LOADED AREA. MUST  #
                                   # BE GIVEN EPL, NUMBER OF EPS, AND  #
                                   # NAME OF LIBRARY (OR ZERO).        #
  
      XREF PROC DIAG;              # ROUTINE FOR ISSUING DIAGNOSTICS   #
  
CONTROL EJECT;
      RC = 0;                      # ASSUME ALL WILL GO WELL.          #
      DBP$EPLGR = CMM$AGR(BELOW$HHA);  # ESTABLISH A GROUP-ID FOR A    #
                                       # BLOCK BELOW HHA.              #
  
                                   # GET SPACE FOR THE ENTRY POINT LIST#
                                   # ALLOW FOR DBP$LTL WORDS FOR THE   #
                                   # LOADER TABLES AND TWO SETS OF     #
                                   # (MAXINDEX) ENTRY POINTS. (NEED TWO#
                                   # SETS OF EP-S FOR A LIBLOAD)       #
      P<DBP$EPL> = CMM$ALF (DBP$LTL + 2*MAXINDEX, FIXED$LWA,
                            DBP$EPLGR); 
  
      DBP$LIB = 0;
      P<AREA$TABLE> = AREATBLPTR;  # POINT TO THE SUBSCHEMA TABLE      #
      NEXTTABLE = AT$FORWARD;      # SKIP FIRST TABLE (SUBSCHEMA)      #
      FOR NEXTTABLE = NEXTTABLE WHILE NEXTTABLE NQ 0 DO 
        BEGIN 
        P<AREA$TABLE> = NEXTTABLE; # POSITION TO THE NEXT AREA TABLE   #
        NEXTTABLE = AT$FORWARD;    # GET POINTER FOR NEXT NEXT-TABLE   #
        IF AT$DBPROC NQ 0 THEN     # IF THERE ARE DBP PROCS FOR AREA   #
          BEGIN 
          P<DBP$TBL> = P<AREA$TABLE> + AT$DBPROC;  # DBP NAMES  ARRAY  #
          FOR I=1 STEP 1 UNTIL ON"ENDLIST" - 1 DO # FOR EACH POSSIBLE  #
                                                  # DBP EXIT           #
            BEGIN 
            IF DBP$TBLWORD[I] NQ 0 THEN   # WE FOUND A DBP NAME        #
              BEGIN 
              NEWEP = TRUE;        # ASSUME A NEW UNIQUE ENTRY POINT   #
              FOR J = 0 STEP 1 UNTIL INDEX-1 DO 
                BEGIN 
                IF DBP$EPLNAME[J] EQ DBP$TBLNAME[I] THEN # FOUND THE EP#
                  BEGIN 
                  DBP$TBLADDR[I] = J;  # INDEX OF EP ALREADY THERE     #
                  NEWEP = FALSE;       # NOT A NEW UNIQUE ENTRY POINT  #
                  J = INDEX;           # PREPARE TO FORCE OUT OF LOOP  #
                  TEST J; 
                  END 
                END 
  
              IF NEWEP THEN        # IF EP WAS NOT IN THE LIST         #
                BEGIN 
                DBP$EPLWORD[INDEX] = 0; 
                DBP$EPLNAME[INDEX] = DBP$TBLNAME[I];
                DBP$TBLADDR[I] = INDEX;    # SAVE INDEX OF NAME IN EPL #
                INDEX = INDEX + 1;         # EPL HAS GROWN BY 1        #
                IF INDEX GR MAXINDEX THEN  # IF NEED MORE EPL SPACE    #
                  BEGIN 
                  DIAG (317);      # INTERNAL ERROR - TOO MANY EP-S    #
                  RC = 1;          # NOT ABLE TO LOAD THE ENTRY POINTS #
                  GOTO EXIT;       # SKIP TO EXIT PROCESSING           #
                  END 
                END 
              END 
            END 
  
          IF DBP$TBLWORD[0] NQ 0 THEN  # IF SHOULD LOAD FROM A LIBRARY #
            BEGIN 
            DBP$LIB = DBP$TBLWORD[0]; 
            END 
          END 
        END 
  
      IF INDEX NQ 0 THEN           # IF THERE WERE SOME ENTRY POINTS   #
        BEGIN 
        DBP$PIL(DBP$EPL, INDEX, DBP$LIB, DBP$FWA);  # LOAD THE EPS     #
        P<AREA$TABLE> = AREATBLPTR;  # POINT TO THE SUBSCHEMA TABLE    #
        NEXTTABLE = AT$FORWARD;      # SKIP THE FIRST TABLE (SUBSCHEMA)#
  
                                   # FOR EACH AREA TABLE...            #
        FOR NEXTTABLE = NEXTTABLE WHILE NEXTTABLE NQ 0 DO 
          BEGIN 
          P<AREA$TABLE> = NEXTTABLE; # POSITION TO NEXT AREA TABLE     #
          NEXTTABLE = AT$FORWARD;    # POINTER FOR NEXT NEXT-TABLE     #
          IF AT$DBPROC NQ 0 THEN   # IF THERE ARE DBP PROCS FOR AREA   #
            BEGIN 
            P<DBP$TBL> = P<AREA$TABLE> + AT$DBPROC; # TABLE FOR NAMES  #
  
            FOR I=1 STEP 1 UNTIL ON"ENDLIST" - 1 DO  #FOR EACH POSSIBLE#
                                                     # DBP EXIT        #
              BEGIN 
              IF DBP$TBLWORD[I] EQ 0 THEN   # IF NO NAMED ENTRY POINT  #
                BEGIN 
                TEST I;                     # SKIP THIS TABLE ENTRY    #
                END 
  
              J = DBP$TBLADDR[I];  # (J) = INDEX INTO EPL FOR THIS EP  #
              IF DBP$EPLADDR[J] EQ 0 THEN  # NO EP OF THIS NAME FOUND  #
                BEGIN 
                RC = 1;            # LOAD WAS NOT PERFECT              #
                DIAG(315, DBP$TBLNAME[I], AT$AFITPOS);   # MISSING EP  #
                END 
  
              ELSE                 # THERE IS AN ADDRESS FOR THIS EP   #
                BEGIN 
                DBP$TBLADDR[I] = DBP$EPLADDR[J];   # SAVE ITS ADDRESS  #
                END 
  
              END 
            END 
          IF DBP$TBLWORD[ON"SDAHASH"] NQ 0 THEN  # IF A HASHING ROUTINE#
            BEGIN 
            P<FIT> = LOC (AT$AFITPOS);  # LOCATE THE AREA FIT          #
            FITHRL = DBP$TBLADDR[ON"SDAHASH"];   #INSERT ADDRESS OF    # DBP$LOD
                                                 # USERS HASH ROUTINE  #
            END 
  
          END 
        END 
  
  
  
EXIT:                              # BEGIN EXIT/CLEANUP CODE           #
      CMM$FGR(DBP$EPLGR);          # FREE THE EPL LIST BY GROUP ID     #
      IF RC NQ 0 THEN              # IF LOAD HAD SOME ERRORS           #
        BEGIN 
        IF DBP$FWA NQ 0 THEN       # IF SOMETHING WAS LOADED           #
          BEGIN 
          CMM$FRF(DBP$FWA);        # FREE THE LOADED SPACE             #
          DBP$FWA = 0;             # CLEAR POINTER TO FWA OF DBP BLOCK #
          END 
        END 
  
      RETURN; 
      END 
      TERM
