*DECK DB$CLOK 
USETEXT UTMPTTX 
USETEXT UTCITTX 
USETEXT UTCDFTX 
USETEXT CUGBATX 
      PROC DB$CLOK(LOCKSCHE); 
 #
  
  *   DB$CLOK - BUILD A PRIVACY LOCK TABLE       PAGE  1
  *   STEVEN P. LEVIN                            DATE  01/12/76 
  
  DC  PURPOSE 
  
      BUILD A PRIVACY LOCK TABLE IN CORE BY PROCESSING THOSE PARTS OF 
      A PRIVACY LOCK ENTRY NOT SPECIFIC TO A PARTICULAR DATA BASE 
      ELEMENT TYPE, COMBINING THIS WITH SPECIFIC DATA PROVIDED BY THE 
      CALLER OF DB$CLOK, AND PUTTING THIS IN THE TABLE AS A NEW ENTRY.
  
  DC  ENTRY CONDITIONS
  
      PARAMETER LOCKSCHE IS TRUE IF A SCHEMA LOCK, FALSE IF SUBSCHEMA.
      THE FOLLOWING COMMON ARRAYS AND ITEMS SHOULD HAVE VALID VALUES: 
      LOCKDATA - ARRAY FOR NEW PRIVACY LOCK TABLE DATA, WHICH SHOULD
                 CONTAIN INFORMATION FOR OPTION FLAGS, DATA BASE
                 ELEMENT TYPE, AND GREATER AND LESSER ELEMENT ORDINALS
      PLCURENT - PRIVACY LOCK TABLE CURRENT LENGTH IN WORDS 
      PLNUMBER - PRIVACY LOCK TABLE NUMBER OF ENTRIES INSERTED
      PLOKADDR - PRIVACY LOCK BLOCK ADDRESS OF WORD AFTER HEADER WORD 
      PLOPOINT - PRIVACY LOCK TABLE BLOCK MANAGED MEMORY POINTER WORD 
      PLPRIOR  - PRIVACY LOCK TABLE PRIOR LENGTH IN WORDS 
      SBGETFWA - SUBSCHEMA LOCK ENTRY FWA (NEEDED IF LOCKSCHE FALSE)
      SCGETFWA - SCHEMA LOCK ENTRY FWA (NEEDED IF LOCKSCHE IS TRUE) 
      SCHEADDR - SCHEMA BLOCK ADDR OF WD AFTER HEADER (LOCKSCHE TRUE) 
      SUBSADDR - SUBSCHEMA BLOCK ADDR OF WD AFTER HEADER (LOCKSCHE F) 
      FURTHER EITHER THE SCHEMA (LOCKSCHE TRUE) OR SUBSCHEMA (LOCKSCHE
      FALSE) MEMORY BLOCK SHOULD HAVE A VALID DDL PRIVACY LOCK CLAUSE.
      THE PRIVACY LOCK MEMORY BLOCK SHOULD CONTAIN THE PARTIALLY BUILT
      PRIVACY LOCK TABLE. (ON THE FIRST CALL TO DB$CLOK, IT IS EMPTY.)
  
  DC  EXIT CONDITIONS 
  
      ON NORMAL RETURN FROM DB$CLOK, DATA IN LOCKDATA WILL BE COMBINED
      WITH OTHER FIELDS FROM THE PROPER DIRECTORY PRIVACY LOCK ENTRY. 
      THE PRIVACY LOCK TABLE WILL CONTAIN THIS AS A NEW LOCK ENTRY. 
      SBGETFWA OR SCGETFWA (FORMER IF LOCKSCHE FALSE, LATTER IF TRUE) 
      WILL CONTAIN THE NEXT DDL DIRECTORY PRIVACY LOCK ENTRY ADDRESS
      IF THERE IS ANOTHER ENTRY, OR WILL BE 0 IF THERE IS NOT ANOTHER.
      IF AN ERROR IS FOUND DURING DB$CLOK 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$CORD - FUNCTION TO FIND THE ORDINAL OF A DATA BASE PROCEDURE 
      DB$SCRM - FUNCTION TO SCRAMBLE A THREE-WORD STRING VALUE
      DB$UAWS - ADJUST THE WORK SPACE USABLE IN A MANAGED MEMORY BLOCK
  
  DC  NON-LOCAL VARIABLES 
  
      LOCKDATA - ARRAY FOR NEW PRIVACY LOCK TABLE DATA, IN WHICH
                 INFORMATION IS PUT FOR THE PROC/LOCK VALUE FLAG, DATA
                 BASE PROCEDURE ORDINAL, AND ENCRYPTED LOCK VALUE 
      PLCURENT - PRIVACY LOCK TABLE CURRENT LENGTH IN WORDS 
      PLNUMBER - PRIVACY LOCK TABLE NUMBER OF ENTRIES INSERTED
      PLPRIOR  - PRIVACY LOCK TABLE PRIOR LENGTH IN WORDS 
      SBGETFWA - SUBSCHEMA LOCK ENTRY FWA (RESET IF LOCKSCHE IS FALSE)
      SCGETFWA - SCHEMA LOCK ENTRY FWA (RESET IF LOCKSCHE IS TRUE)
      IN ADDITION, THE CONTENT OF THE PRIVACY LOCK TABLE WILL CHANGE. 
  
  DC  DESCRIPTION 
  
      SET POINTERS, OFFSETS, COUNTERS, AND LOCK HEADER INFO ITEMS.
      DO EVERYTHING BELOW FOR EACH LOCK IN THE ENTRY, AND THEN RETURN.
      IF THE LOCK IS A LITERAL LOCK USE DB$SCRM TO SCRAMBLE ITS VALUE.
      IF THE LOCK IS A PROCEDURE LOCK, USE DB$CORD TO GET ITS ORDINAL.
      IF THE LOCK IS NEITHER A LITERAL NOR A PROC LOCK ABORT IN ERROR.
      CALL DB$UAWS, AND PUT A NEW ENTRY IN THE PRIVACY LOCK TABLE.
      UPDATE LOCK VALUE OFFSET AND LOCK HEADER POSITION ITEMS.
      UPDATE POINTERS AND LOCK HEADER INFORMATION ITEMS FOR NEXT LOCK.
      IF IT IS A SCHEMA PRIVACY LOCK ENTRY, UPDATE USING SCHEMA DATA. 
      IF A SUBSCHEMA PRIVACY LOCK ENTRY, UPDATE USING SUBSCHEMA DATA. 
      REPEAT EVERYTHING ABOVE (EXCEPT INITIALIZATION) UNTIL LOCKS END.
  
 #
        CONTROL EJECT;
  
        BEGIN                # DB$CLOK #
  
# THE FOLLOWING FORMAL PARAMETER IS PASSED TO DB$CLOK # 
  
        ITEM LOCKSCHE B;     # TRUE IF SCHEMA LOCK FALSE IF SUBSCHEMA#
  
# THE FOLLOWING ARE EXTERNALLY REFERENCED PROCEDURES AND FUNCTIONS #
  
        XREF PROC DB$CERR;   # ERROR HANDLER FOR FATAL ERRORS # 
        XREF FUNC DB$CORD U; # FIND ORDINAL OF A DATA BASE PROCEDURE #
        XREF FUNC DB$SCRM C(30);       # SCRAMBLE 3-WORD STRING VALUE#
        XREF PROC DB$UAWS;   # ADJUST MANAGED MEMORY BLOCK WORK SPACE#
  
        CONTROL NOLIST;      # UTCDF UTCIT UTMPT UTCAR CUGBA CSTLK #
*CALL UTCARDCLS 
*CALL CSTLKDCLS 
        CONTROL LIST;        # RESUME THE LISTING OF THE SOURCE CODE #
  
# THE FOLLOWING ITEMS ARE LOCAL TO DB$CLOK #
  
        ITEM ENTRYLEN I;     # PRIVACY LOCK TABLE ENTRY WORD LENGTH # 
        ITEM LOCKLENC U;     # DDL LOCK VALUE LENGTH IN CHARACTERS #
        ITEM LOCKLENW U;     # DDL LOCK VALUE LENGTH IN WORDS # 
        ITEM LOCKTYPE U;     # DDL LOCK TYPE (FROM LOCK ENTRY HEADER)#
        ITEM POSITNUM I;     # DDL LOCK HEADER POSITION NUMBER (1-5) #
        ITEM POSITOFF I;     # DDL LOCK HEADER POSITION WORD OFFSET # 
        ITEM VALUEADD U;     # DDL LOCK VALUE "ABSOLUTE" CORE ADDRESS#
        ITEM VALUEOFF U;     # DDL LOCK VALUE WORD OFFSET IN ENTRY #
  
# THE FOLLOWING LOCAL BASED ARRAY FOR A SUBSCHEMA GLOBAL PRIVACY LOCK#
  
        BASED ARRAY SBPRLOK[0:0] P(1); # SUBSCHEM GLOBAL PRIVACY LOCK#
  
          BEGIN              # SBPRLOK BASED ARRAY #
  
*CALL SBGPRDCLS 
  
          END                # SBPRLOK BASED ARRAY #
  
# THE FOLLOWING LOCAL BASED ARRAY IS FOR A SCHEMA GLOBAL PRIVACY LOCK#
  
        BASED ARRAY SCPRLOK[0:0] P(1); # SCHEMA GLOBAL PRIVACY LOCK # 
  
          BEGIN              # SCPRLOK BASED ARRAY #
  
*CALL SCGPRDCLS 
  
          END                # SCPRLOK BASED ARRAY #
  
# THE FOLLOWING LOCAL SWITCHES ARE USED TO SIMULATE CASE STATEMENTS # 
  
        SWITCH LABSBSCH      # USED FOR SUBSCHEMA-CONNECTED LABELS #
          CASENDSB, LABSBONE, LABSBTWO, LABSBTHR, LABSBFOR, LABSBFIV; 
        SWITCH LABSCHEM      # USED FOR SCHEMA-CONNECTED LABELS # 
          CASENDSC, LABSCONE, LABSCTWO, LABSCTHR, LABSCFOR, LABSCFIV; 
        CONTROL EJECT;
  
# SET POINTERS, OFFSETS, COUNTERS, AND LOCK HEADER INFORMATION ITEMS #
  
        P<CSLOKTBL> = LOC(LOCKDATA);   # POINT TO LOCK DATA ARRAY # 
        IF CSLKTYPE[0] GR 3  # CHECK IF DB ELEMENT TYPE IS ILLEGAL #
          THEN XCALL DB$CERR("7501CLOK",CSLKTYPE[0]);      # ABORT #
        IF LOCKSCHE          # CHECK IF A SCHEMA PRIVACY LOCK ENTRY # 
          THEN               # PROCESS SCHEMA PRIVACY LOCK ENTRY #
            BEGIN 
              P<SCPRLOK> = SCHEADDR;   # POINT TO SCHEMA MEMORY BLOCK#
              LOCKLENC = SCPRLOKLCH4[0];         # LOCK VALUE LEN CHR#
              LOCKLENW = SCPRLOKLWD4[0];         # LOCK VALUE LEN WRD#
              LOCKTYPE = SCPRLOKTYP4[0];         # DDL LOCK TYPE #
              IF SCHNXPRIVPTR[0] GR 0  # CHECK IF ANOTHER LOCK ENTRY #
                THEN SCGETFWA = SCGETFWA + SCHNXPRIVPTR[0]; 
                ELSE SCGETFWA = 0;     # THERE IS NO OTHER LOCK ENTRY#
              VALUEOFF = SCHPRVALPTR[0];         # LOCK VALUE OFFSET #
              VALUEADD = SCHEADDR + VALUEOFF;    # LOCK VALUE ADDRESS#
            END 
          ELSE               # PROCESS SUBSCHEMA PRIVACY LOCK ENTRY # 
            BEGIN 
              P<SBPRLOK> = SUBSADDR;   # POINT TO SUBSCHEMA BLOCK # 
              LOCKLENC = SBPRLOKLCH4[0];         # LOCK VALUE LEN CHR#
              LOCKLENW = SBPRLOKLWD4[0];         # LOCK VALUE LEN WRD#
              LOCKTYPE = SBPRLOKTYP4[0];         # DDL LOCK TYPE #
              IF SBNXPRIVPTR[0] GR 0   # CHECK IF ANOTHER LOCK ENTRY #
                THEN SBGETFWA = SBGETFWA + SBNXPRIVPTR[0]; # NEXT FWA#
                ELSE SBGETFWA = 0;     # THERE IS NO OTHER LOCK ENTRY#
              VALUEOFF = SBPRVALPTR[0];          # LOCK VALUE OFFSET #
              VALUEADD = SUBSADDR + VALUEOFF;    # LOCK VALUE ADDRESS#
            END 
        POSITNUM = 4;        # DDL LOCK HEADER POSITION NUMBER #
        POSITOFF = 0;        # DDL LOCK HEADER POSITION WORD OFFSET # 
  
# THE FOLLOWING FOR-LOOP IS EXECUTED ONCE FOR EACH LOCK IN THE ENTRY #
  
        LOOP WHILE LOCKTYPE NQ 6 DO    # LOOP IS A DEF FOR A FOR-LOOP#
          BEGIN              # MAJOR LOOP FOR LOCKS IN PRIVACY ENTRY #
            PLNUMBER = PLNUMBER + 1;   # PRIVACY LOCK ENTRIES NUMBER #
            P<GETENTRY> = VALUEADD;    # POINT TO THE LOCK VALUE #
  
# IF THE LOCK IS A LITERAL LOCK, USE DB$SCRM TO SCRAMBLE ITS VALUE #
  
            IF LOCKTYPE EQ 1 # CHECK IF THE LOCK IS A LITERAL LOCK #
              THEN           # LOCK IS A LITERAL LOCK, SO SCRAMBLE IT#
                BEGIN 
                  ENTRYLEN = 4;        # PRIVACY LOCK TABLE ENTRY LEN#
                  CSLKPROC[0] = FALSE; # FALSE FOR LITERAL LOCK VALUE#
                  CSLKVALU[0] = GETWDTHR[0];     # LITERAL LOCK VALUE#
                  IF LOCKLENC LS 30    # BLANK-FILL LITERAL ON RIGHT #
                    THEN C<LOCKLENC,30 - LOCKLENC> CSLKVALU[0] = " "; 
                  CSLKVALU[0] = DB$SCRM(CSLKVALU[0]);      # SCRAMBLE#
                END 
  
# IF THE LOCK IS A DB PROCEDURE LOCK, USE DB$CORD TO GET ITS ORDINAL #
  
              ELSE           # THE LOCK IS NOT A LITERAL LOCK VALUE # 
                IF LOCKTYPE EQ 2       # CHECK IF LOCK IS A PROC LOCK#
                  THEN       # LOCK IS A DB PROC LOCK, SO GET ORDINAL#
                    BEGIN 
                      ENTRYLEN = 1;    # PRIVACY LOCK TABLE ENTRY LEN#
                      CSLKPROC[0] = TRUE;        # TRUE FOR PROC LOCK#
                      CSLKPORD[0] =    # DATA BASE PROCEDURE ORDINAL #
                        DB$CORD(B<0,42> GETUNSIG[0],LOCKSCHE);
                    END 
  
# IF THE LOCK IS NEITHER A LITERAL NOR A PROC LOCK, ABORT IN ERROR #
  
                  ELSE       # LOCK TYPE IS UNPROCESSABLE, SO ABORT # 
                    IF LOCKSCHE        # CHECK IF A SCHEMA LOCK ENTRY#
                      THEN XCALL DB$CERR("7502CLOK",LOCKTYPE); #ABORT#
                      ELSE XCALL DB$CERR("7503CLOK",LOCKTYPE); #ABORT#
  
# CALL DB$UAWS, AND PUT A NEW ENTRY IN THE PRIVACY LOCK TABLE # 
  
            XCALL DB$UAWS(LOC(PLOPOINT),ENTRYLEN);         # UP SPACE#
            P<CSLOCTBL> = PLOKADDR + PLPRIOR;    # POINT TO PRIOR # 
            CSLCNEXT[0] = TRUE;        # ANOTHER ENTRY FOLLOWS PRIOR #
            P<CSLOCTBL> = PLOKADDR + PLCURENT;   # POINT TO CURRENT # 
            CSLCOPTN[0] = LNO 0;       # SET EVERY OPTION FLAG TO ONE#
            IF CSLCOPTN[0] EQ CSLKOPTN[0]        # IF OPTIONS SAME #
              THEN           # ABORT BECAUSE AT LEAST ONE SHOULD BE 0#
                BEGIN 
                  IF LOCKSCHE          # CHECK IF A SCHEMA LOCK ENTRY#
                    THEN XCALL DB$CERR("7504CLOK",PLNUMBER); # ABORT #
                    ELSE XCALL DB$CERR("7505CLOK",PLNUMBER); # ABORT #
                END 
            CSLCNEXT[0] = FALSE;       # THIS IS LAST ENTRY SO FAR #
            CSLCPROC[0] = CSLKPROC[0]; # TRUE=DBP,FALSE=LITERAL VALUE#
            CSLCOPTN[0] = CSLKOPTN[0]; # PRIVACY LOCK OPTION FLAGS #
            CSLCTYPE[0] = CSLKTYPE[0]; # DATA BASE ELEMENT TYPE # 
            CSLCGORD[0] = CSLKGORD[0]; # GREATER DB ELEMENT ORDINAL # 
            CSLCLORD[0] = CSLKLORD[0]; # LESSER DB ELEMENT ORDINAL #
            IF CSLKPROC[0]   # CHECK IF THE LOCK IS A PROCEDURE LOCK #
              THEN CSLCPORD[0] = CSLKPORD[0];    # PROCEDURE ORDINAL #
              ELSE CSLCVALU[0] = CSLKVALU[0];    # ENCRYPTED LITERAL #
            PLPRIOR = PLCURENT;        # PRIVACY LOCK TABLE PRIOR LEN#
            PLCURENT = PLCURENT + ENTRYLEN;      # TABLE CURRENT LEN #
  
# UPDATE LOCK VALUE OFFSET AND HEADER POSITION ITEMS FOR NEXT LOCK #
  
            VALUEOFF = VALUEOFF + LOCKLENW;      # LOCK VALUE OFFSET #
            POSITNUM = POSITNUM + 1;   # LOCK HEADER POSITION NUMBER #
            IF POSITNUM GR 5 # IF HEADER POSITIONS IN THIS WORD DONE #
              THEN           # SET HEADER POSITION ITEMS FOR NEXT WRD#
                BEGIN 
                  POSITNUM = 1;        # LOCK HEADER POSITION NUMBER #
                  POSITOFF = POSITOFF + 1;       # POSITION OFFSET #
                END 
  
# UPDATE POINTERS AND LOCK HEADER INFORMATION ITEMS FOR THE NEXT LOCK#
  
            IF LOCKSCHE      # CHECK IF A SCHEMA PRIVACY LOCK ENTRY # 
  
# IF IT IS A SCHEMA PRIVACY LOCK ENTRY, UPDATE USING SCHEMA DATA #
  
              THEN           # UPDATE USING SCHEMA LOCK ENTRY DATA #
                BEGIN 
                  P<SCPRLOK> = SCHEADDR + POSITOFF;        # HEADER # 
                  CASE LABSCHEM[POSITNUM] OF # LABSCONE TO LABSCFIV #;
                    LABSCONE: LOCKLENC = SCPRLOKLCH1[0];   # LEN CHAR#
                              LOCKLENW = SCPRLOKLWD1[0];   # LEN WORD#
                              LOCKTYPE = SCPRLOKTYP1[0];   # TYPE # 
                              GOTO CASENDSC;     # POSITION 1 DONE #
                    LABSCTWO: LOCKLENC = SCPRLOKLCH2[0];   # LEN CHAR#
                              LOCKLENW = SCPRLOKLWD2[0];   # LEN WORD#
                              LOCKTYPE = SCPRLOKTYP2[0];   # TYPE # 
                              GOTO CASENDSC;     # POSITION 2 DONE #
                    LABSCTHR: LOCKLENC = SCPRLOKLCH3[0];   # LEN CHAR#
                              LOCKLENW = SCPRLOKLWD3[0];   # LEN WORD#
                              LOCKTYPE = SCPRLOKTYP3[0];   # TYPE # 
                              GOTO CASENDSC;     # POSITION 3 DONE #
                    LABSCFOR: LOCKLENC = SCPRLOKLCH4[0];   # LEN CHAR#
                              LOCKLENW = SCPRLOKLWD4[0];   # LEN WORD#
                              LOCKTYPE = SCPRLOKTYP4[0];   # TYPE # 
                              GOTO CASENDSC;     # POSITION 4 DONE #
                    LABSCFIV: LOCKLENC = SCPRLOKLCH5[0];   # LEN CHAR#
                              LOCKLENW = SCPRLOKLWD5[0];   # LEN WORD#
                              LOCKTYPE = SCPRLOKTYP5[0];   # TYPE # 
                  CASENDSC: VALUEADD = SCHEADDR + VALUEOFF; 
                END 
  
# IF IT IS A SUBSCHEMA PRIVACY LOCK ENTRY UPDATE USING SUBSCHEMA DATA#
  
              ELSE           # UPDATE USING SUBSCHEMA LOCK ENTRY DATA#
                BEGIN 
                  P<SBPRLOK> = SUBSADDR + POSITOFF;        # HEADER # 
                  CASE LABSBSCH[POSITNUM] OF # LABSBONE TO LABSBFIV #;
                    LABSBONE: LOCKLENC = SBPRLOKLCH1[0];   # LEN CHAR#
                              LOCKLENW = SBPRLOKLWD1[0];   # LEN WORD#
                              LOCKTYPE = SBPRLOKTYP1[0];   # TYPE # 
                              GOTO CASENDSB;     # POSITION 1 DONE #
                    LABSBTWO: LOCKLENC = SBPRLOKLCH2[0];   # LEN CHAR#
                              LOCKLENW = SBPRLOKLWD2[0];   # LEN WORD#
                              LOCKTYPE = SBPRLOKTYP2[0];   # TYPE # 
                              GOTO CASENDSB;     # POSITION 2 DONE #
                    LABSBTHR: LOCKLENC = SBPRLOKLCH3[0];   # LEN CHAR#
                              LOCKLENW = SBPRLOKLWD3[0];   # LEN WORD#
                              LOCKTYPE = SBPRLOKTYP3[0];   # TYPE # 
                              GOTO CASENDSB;     # POSITION 3 DONE #
                    LABSBFOR: LOCKLENC = SBPRLOKLCH4[0];   # LEN CHAR#
                              LOCKLENW = SBPRLOKLWD4[0];   # LEN WORD#
                              LOCKTYPE = SBPRLOKTYP4[0];   # TYPE # 
                              GOTO CASENDSB;     # POSITION 4 DONE #
                    LABSBFIV: LOCKLENC = SBPRLOKLCH5[0];   # LEN CHAR#
                              LOCKLENW = SBPRLOKLWD5[0];   # LEN WORD#
                              LOCKTYPE = SBPRLOKTYP5[0];   # TYPE # 
                  CASENDSB: VALUEADD = SUBSADDR + VALUEOFF; 
                END 
          END                # MAJOR LOOP FOR LOCKS IN PRIVACY ENTRY #
  
# MAJOR LOOP WAS EXECUTED ONCE FOR EACH LOCK IN THE ENTRY, SO RETURN #
  
        RETURN;              # ALL LOCKS IN PRIVACY ENTRY PROCESSED # 
  
        END                  # DB$CLOK #
  
      TERM
