*DECK DB$COPT 
USETEXT UTMPTTX 
USETEXT UTCITTX 
USETEXT UTCDFTX 
      PROC DB$COPT; 
  
 #
  
  *   DB$COPT - BUILD A PROCEDURE OPTION TABLE   PAGE  1
  *   STEVEN P. LEVIN                            DATE  01/09/76 
  
  DC  PURPOSE 
  
      BUILD A PROCEDURE OPTION TABLE IN CORE BY DECIDING WHERE NEW
      ENTRIES SHOULD BE INSERTED IN THE TABLE AND PUTTING THEM THERE. 
  
  DC  ENTRY CONDITIONS
  
      THE FOLLOWING COMMON ARRAYS AND ITEMS SHOULD HAVE VALID VALUES: 
      OPTNDATA - ARRAY FOR DATA TO BE PUT IN THE PROC OPTION TABLE
      POCOLUMN - ARRAY ENTRIES FOR PROC OPTION TABLE COLUMN LENGTHS 
      POCURENT - PROCEDURE OPTION TABLE CURRENT LENGTH IN WORDS 
      PONUMBER - PROCEDURE OPTION TABLE NUMBER OF ENTRIES INSERTED
      POPPOINT - PROC OPTION TABLE MANAGED MEMORY BLOCK POINTER WORD
      POPTADDR - PROC OPTION BLOCK ADDRESS OF WORD AFTER HEADER WORD
      WRKPOPNT - ARRAY ENTRY ZEROED WHEN DB$COPT IS FIRST CALLED FOR A
                 SPECIFIC DATA BASE ELEMENT"S PROC LIST.  THEREAFTER, 
                 DB$COPT MAINTAINS WRKPOPNT IF THE PROC LIST EXPANDS. 
  
  DC  EXIT CONDITIONS 
  
      ON NORMAL RETURN FROM DB$COPT, THE PROCEDURE OPTION TABLE WILL
      CONTAIN A NEW ENTRY DERIVED FROM THE DATA IN THE ARRAY OPTNDATA.
      SUBENTRIES OF THE WRKPOPNT ARRAY ENTRY WILL CONTAIN CURRENT PROC
      LIST POINTER INFORMATION SO THAT WHEN A PROCEDURE LIST IS ALL 
      BUILT, THE POINTER INFORMATION CAN BE PUT INTO A CST WORK BLOCK.
      IF AN ERROR IS FOUND DURING DB$COPT PROCESSING, THE CST BUILDER 
      (AT LEAST) WILL BE ABORTED THROUGH A CALL TO THE MODULE DB$CERR.
  
  DC  CALLING ROUTINES
  
      DB$CARE - BUILD AN AREA WORK BLOCK IN THE WORK BLOCK CORE BLOCK 
      DB$CREC - BUILD A RECORD WORK BLOCK IN THE WORK BLOCK CORE BLOCK
  
  DC  CALLED ROUTINES 
  
      DB$CERR - ERROR MESSAGE AND RETURN HANDLER FOR FATAL ERRORS 
      DB$UAWS - ADJUST THE WORK SPACE USABLE IN A MANAGED MEMORY BLOCK
  
  DC  NON-LOCAL VARIABLES 
  
      POCOLUMN - ARRAY ENTRIES FOR PROC OPTION TABLE COLUMN LENGTHS 
      POCURENT - PROCEDURE OPTION TABLE CURRENT LENGTH IN WORDS 
      PONUMBER - PROCEDURE OPTION TABLE NUMBER OF ENTRIES INSERTED
      WRKPOPNT - ARRAY ENTRY UPDATED BY DB$COPT TO REFLECT CURRENT
                 PROCEDURE LIST POINTER INFORMATION SO THAT WHEN A
                 PROCEDURE LIST IS ENTIRELY BUILT, THE POINTER
                 INFORMATION CAN BE PUT INTO A CST WORK BLOCK 
      IN ADDITION, THE CONTENT OF THE PROC OPTION TABLE WILL CHANGE.
  
  DC  DESCRIPTION 
  
      RESET PROC OPTION ENTRIES NUMBER.  ABORT IF OPTNDATA HAS ERRORS.
      IF THIS IS A NEW PROC LIST DETERMINE WHERE THE LIST WILL BE PUT.
      IF NEEDED, CALL DB$UAWS TO INCREASE THE PROC OPTION TABLE SIZE. 
      PREPARE TO PUT A NEW ENTRY IN THE TABLE.  ABORT ON TRUNCATION.
      USING DATA IN OPTNDATA PUT A NEW ENTRY IN THE PROC OPTION TABLE.
      RETURN FROM DB$COPT WITH A NEW ENTRY IN THE PROC OPTION TABLE.
  
 #
        CONTROL EJECT;
  
        BEGIN                # DB$COPT #
  
# THE FOLLOWING ARE EXTERNALLY REFERENCED PROCEDURES #
  
        XREF PROC DB$CERR;   # ERROR HANDLER FOR FATAL ERRORS # 
        XREF PROC DB$UAWS;   # ADJUST MANAGED MEMORY BLOCK WORK SPACE#
  
        CONTROL NOLIST;      # DCLS: UTCDF UTCIT UTMPT UTCAR CSTOP #
*CALL UTCARDCLS 
*CALL CSTOPDCLS 
        CONTROL LIST;        # RESUME THE LISTING OF THE SOURCE CODE #
  
# THE FOLLOWING ITEM IS LOCAL TO DB$COPT #
  
        ITEM COLUMN I;       # PROCEDURE OPTION TABLE COLUMN (0 OR 1)#
        CONTROL EJECT;
  
# RESET PROC OPTION ENTRIES NUMBER.  ABORT IF OPTNDATA HAS AN ERROR. #
  
        PONUMBER = PONUMBER + 1;       # PROC OPTION ENTRIES NUMBER # 
        P<CSOPTTBL> = LOC(OPTNDATA);   # POINT TO PROC OPTION DATA #
        IF CSORTYPE[0] NQ 0            # IF TYPE OF OPTIONS ILLEGAL # 
          THEN XCALL DB$CERR("7401COPT",CSORTYPE[0]);      # ABORT #
        IF CSOROPTN[0] EQ 0 THEN XCALL DB$CERR("7402COPT",PONUMBER);
  
# IF THIS A NEW PROC LIST, DETERMINE WHERE THE LIST IS TO BE PUT #
  
        IF WRKPOPNT[0] EQ 0  # CHECK IF THIS IS A NEW DB PROC LIST #
          THEN               # DETERMINE WHERE THE LIST IS TO BE PUT #
            BEGIN 
              IF POCOLUMN[0] LS POCOLUMN[1]      # IF LEFT IS SMALLER#
                THEN COLUMN = 0;       # PUT LIST IN COLUMN 0 (LEFT) #
                ELSE COLUMN = 1;       # PUT LIST IN COLUMN 1 (RIGHT)#
              WRKPOCOL[0] = COLUMN;    # PROCEDURE OPTION LIST COLUMN#
              WRKPOFWA[0] = POCOLUMN[COLUMN];    # FIRST WORD ADDRESS#
              IF WRKPOFWA[0] NQ POCOLUMN[COLUMN] # IF TRUNCATED ABORT#
                THEN XCALL DB$CERR("7403COPT",POCOLUMN[COLUMN]);
            END 
          ELSE COLUMN = WRKPOCOL[0];   # EXPANSION TO EXISTING LIST # 
  
# IF NEEDED, CALL DB$UAWS TO INCREASE THE PROC OPTION TABLE LENGTH #
  
        IF POCURENT LQ POCOLUMN[COLUMN]          # CHECK CURRENT SIZE#
          THEN               # INCREASE PROC OPTION TABLE SIZE BY ONE#
            BEGIN 
              XCALL DB$UAWS(LOC(POPPOINT),1);    # ADJUST WORK SPACE #
              POCURENT = POCURENT + 1;           # TABLE CURRENT SIZE#
            END 
  
# PREPARE TO PUT A NEW ENTRY IN THE PROC TABLE.  ABORT ON TRUNCATION.#
  
        P<CSOPTTBE> = POPTADDR + POCOLUMN[COLUMN];         #ENTRY LOC#
        POCOLUMN[COLUMN] = POCOLUMN[COLUMN] + 1; # COLUMN LENGTH #
        WRKPOLEN[0] = WRKPOLEN[0] + 1;           # PROC LIST LENGTH # 
        IF WRKPOFWA[0] + WRKPOLEN[0] NQ POCOLUMN[COLUMN]   # SHOULD =#
          THEN               # FIELD TRUNCATION, SO ABORT SUBSCHEMA # 
            XCALL DB$CERR("7404COPT",POCOLUMN[COLUMN] - WRKPOFWA[0]); 
  
# USING DATA IN OPTNDATA, PUT A NEW ENTRY IN THE PROC OPTION TABLE #
  
        IF COLUMN EQ 0       # IF NEW ENTRY IN LEFT (FRONT) COLUMN #
          THEN               # PUT NEW ENTRY IN LEFT (FRONT) COLUMN # 
            BEGIN 
              CSOFPORD[0] = CSORPORD[0];         # DB PROC ORDINAL #
              CSOFTYPE[0] = CSORTYPE[0];         # TYPE OF OPTIONS #
              CSOFOPTN[0] = CSOROPTN[0];         # DBP OPTION FLAGS # 
            END 
          ELSE               # PUT NEW ENTRY IN RIGHT (END) COLUMN #
            BEGIN 
              CSOEPORD[0] = CSORPORD[0];         # DB PROC ORDINAL #
              CSOETYPE[0] = CSORTYPE[0];         # TYPE OF OPTIONS #
              CSOEOPTN[0] = CSOROPTN[0];         # DBP OPTION FLAGS # 
            END 
  
# RETURN FROM DB$COPT WITG A NEW ENTRY NOW IN THE PROC OPTION TABLE # 
  
        RETURN;              # NEW ENTRY NOW IN THE PROC OPTION TABLE#
  
        END                  # DB$COPT #
  
      TERM
