*DECK DB$CREC 
USETEXT UTMPTTX 
USETEXT UTCITTX 
USETEXT UTCDFTX 
USETEXT CUGBATX 
      PROC DB$CREC; 
 #
  *   DB$CREC - BUILD RECORD WORK BLOCK IN CORE  PAGE  1
  *   STEVEN P. LEVIN                            DATE  02/23/76 
  
  DC  PURPOSE 
  
      BUILD A CST RECORD WORK BLOCK IN THE WORK BLOCK MEMORY BLOCK. 
  
  DC  ENTRY CONDITIONS
  
      THE FOLLOWING COMMON ITEMS SHOULD HAVE BEEN GIVEN VALID VALUES: 
      CURORDNL - CURRENT (RECORD) WORK BLOCK (SUBSCHEMA) ORDINAL
      CURTYPE  - CURRENT DATA BASE ELEMENT TYPE (2 IF A RECORD) 
      LENILOCK - RSB (A CDCS TERM) ITEM PRIVACY LOCK TABLE WORD LENGTH
      MCLENREC - MAPPING CAPSULE TABLE LENGTH OF REC CAPSULE ENTRIES
      MCNUMREC - MAPPING CAPSULE TABLE NUMBER OF REC CAPSULE ENTRIES
      SBCURRAD - SUBSCHEMA CURRENT MAIN ENTRY (RECORD HEADER) ADDRESS 
      SBFIRCAP - SUBSCHEMA FIRST MAPPING CAPSULE WORD ADDRESS 
      SBMAXENT - SUBSCHEMA MAXIMUM SUBENTRY LENGTH IN WORDS 
      SBNEXTAD - SUBSCHEMA NEXT MAIN ENTRY (RECORD HEADER) ADDRESS
      SCHEADDR - SCHEMA MEMORY BLOCK ADDRESS OF WORD AFTER HEADER WORD
      SCMAXENT - SCHEMA MAXIMUM SUBENTRY LENGTH IN WORDS
      SCMAXREC - SCHEMA MAX REC LENGTH IN CHARS OF RECS IN SUBSCHEMA
      SUBSADDR - SUBSCHEMA MEMORY BLOCK ADDRESS OF WD AFTER HEADER WD 
      WORKADDR - WORK BLOCK MAIN BLOCK ADDRESS OF WORD AFTER HEADER WD
      WORPOINT - WORK BLOCK MAIN BLOCK MANAGED MEMORY POINTER WORD
      FURTHER, THE SUBSCHEMA AND SCHEMA DIRECTORIES SHOULD BE VALID.
  
  DC  EXIT CONDITIONS 
  
      ON NORMAL DB$CREC RETURN, THE MD FILE WILL CONTAIN A NEW RECORD 
      WORK BLOCK AT THE END OF THE PARTIALLY BUILT CST ALREADY THERE. 
      SBCURRAD WILL CONTAIN THE NEWLY-MADE RECORD"S SUBSCHEMA ADDRESS.
      SBNEXTAD WILL CONTAIN THE NEXT SUBSCHEMA (RECORD) ENTRY ADDRESS.
      IF AN ERROR IS FOUND DURING DB$CREC PROCESSING, THE CST BUILDER 
      (AT LEAST) WILL BE ABORTED THROUGH A CALL TO THE MODULE DB$CERR.
  
  DC  CALLING ROUTINES
  
      DB$CBLD - CONDENSED SCHEMA/SUBSCHEMA TABLE BUILDER MAIN MODULE
  
  DC  CALLED ROUTINES 
  
      DE$DISC - DIRECTORY ACCESS ROUTINE FOR READING SCHEMA ITEM ENTRY
      DB$CERR - ERROR MESSAGE AND RETURN HANDLER FOR FATAL ERRORS 
      DB$CESC - SCHEMA FILE CYBER RECORD MANAGER (CRM) ERROR HANDLER
      DB$CFIL - FUNCTION TO BLANK OR BINARY ZERO CHARACTER FILL STRING
      DB$CGSB - DB$CGSD ENTRY POINT FOR A SUBSCHEMA DIRECTORY CRM GET 
      DB$CGSC - DB$CGSD ENTRY POINT FOR A SCHEMA DIRECTORY CRM GET
      DB$CLOK - PRIVACY LOCK TABLE BUILDER AND NEW LOCK ENTRY INSERTER
      DB$CNSC - USE AN ENTRY NAME TO GET THAT ENTRY"S SCHEMA HEADER 
      DB$COPT - PROCEDURE OPTION TABLE MANAGER FOR NEW ENTRY INSERTION
      DB$CORD - FUNCTION TO FIND THE ORDINAL OF A DATA BASE PROCEDURE 
      DB$CPUT - PUT WORDS FROM CORE INTO THE MASTER DIRECTORY FILE
      DB$UADR - UPDATE MANAGED MEMORY BLOCK FIRST-USABLE-ADDRESS WORDS
      DB$UAWS - ADJUST THE WORK SPACE USABLE IN A MANAGED MEMORY BLOCK
  
  DC  NON-LOCAL VARIABLES 
  
      CURNAME  - CURRENT DATA BASE ELEMENT NAME 
      CURSCRAT - CURRENT SCRATCH NAME (USED AS A TEMPORARY AT TIMES)
      CURTYPE  - CURRENT DATA BASE ELEMENT TYPE (2 = RECORD, 3 = ITEM)
      LENILOCK - RSB (A CDCS TERM) ITEM PRIVACY LOCK TABLE WORD LENGTH
      LOCKDATA - ARRAY FOR DATA DB$CLOK PUTS IN THE PRIVACY LOCK TABLE
      MCLENREC - MAPPING CAPSULE TABLE LENGTH OF REC CAPSULE ENTRIES
      MCNUMREC - MAPPING CAPSULE TABLE NUMBER OF REC CAPSULE ENTRIES
      OPTNDATA - ARRAY FOR DATA DB$COPT PUTS IN THE PROC OPTION TABLE 
      SBCURRAD - SUBSCHEMA CURRENT MAIN ENTRY (RECORD HEADER) ADDRESS 
      SBGETFWA - SUBSCHEMA FIRST WORD ADDRESS TO BE READ BY A CRM GET 
      SBNEXTAD - SUBSCHEMA NEXT MAIN ENTRY (RECORD HEADER) ADDRESS
      SCGETFWA - SCHEMA FIRST WORD ADDRESS TO BE READ BY A CRM GET
      SCMAXREC - SCHEMA MAX REC LENGTH IN CHARS OF RECS IN SUBSCHEMA
      WOCURENT - WORK BLOCK MANAGED MEMORY BLOCK CURRENT WORD LENGTH
      WRKPOARR - ARRAY FOR WORK BLOCK PROC OPTION TABLE POINTER INFO
      IN ADDITION, THE CONTENT OF THE MASTER DIRECTORY FILE WILL BE 
      MODIFIED WHEN THE NEW RECORD WORK BLOCK IS WRITTEN TO THE MASTER
      DIRECTORY AT THE END OF THE PARTIALLY BUILT CST ALREADY THERE.
      FURTHERMORE, THE CONTENT OF THE WORK BLOCK MAIN MANAGED MEMORY
      BLOCK WILL CHANGE AS THE RECORD WORK BLOCK IS BUILT IN IT.
  
  DC  DESCRIPTION 
  
      CALL DB$CGSB TO GET NEXT SUBSCHEMA REC HEADER.  ABORT ON ERROR. 
      CALL DB$CNSC TO GET RELATED SCHEMA REC HEADER.  ABORT ON ERROR. 
      FILL IN THE REC WORK BLOCK USING INFO IN CORE.  ABORT ON ERROR. 
      IF THERE IS SCHEMA DB PROC OPTION INFO PROCESS IT USING DB$COPT.
      IF THERE IS SUBSCHEMA LOCK INFORMATION PROCESS IT USING DB$CLOK.
      IF THERE IS ONLY SCHEMA LOCK INFO, PROCESS IT USING DB$CLOK.
      PREPARE TO PROCESS ITEM INFORMATION BY DOING INITIALIZATIONS. 
      PROCESS ITEM INFORMATION, STARTING WITH GETTING ITEM HEADERS. 
      IF THERE IS SUBSCHEMA ITEM LOCK INFO, PROCESS IT USING DB$CLOK. 
      IF THERE IS ONLY SCHEMA ITEM LOCK INFO PROCESS IT USING DB$CLOK.
      IF NON-DEFAULT ITEM LOCK INFO NEEDED, PUT IT IN ITEM LOCK TABLE.
      FILL IN THE REMAINING RECORD WORK BLOCK FIELDS.  ABORT ON ERROR.
      CALL DB$CPUT TO PUT IN MD.  CALL DB$UAWS TO ADJUST WORK SPACE.
      RESET SOME ITEMS IN COMMON WHICH RELATE TO THE CURRENT ACTIVITY.
      RETURN FROM DB$CREC WITH THE NEW REC WORK BLOCK NOW IN THE MD.
 #
        CONTROL EJECT;
  
        BEGIN                # DB$CREC #
  
# THE FOLLOWING ARE EXTERNALLY REFERENCED PROCEDURES AND FUNCTIONS #
  
        XREF PROC DE$DISC;   # DIRECTORY ACCESS READ SCHEMA ITEMS # 
        XREF PROC DB$CERR;   # ERROR HANDLER FOR FATAL ERRORS # 
        XREF PROC DB$CESC;   # SCHEMA FILE CRM ERROR HANDLER #
        XREF FUNC DB$CFIL C(30);       # BLANK OR ZERO CHARACTER FILL#
        XREF PROC DB$CGSB;   # DB$CGSD ENTRY POINT FOR SUBSCHEMA GET #
        XREF PROC DB$CGSC;   # DB$CGSD ENTRY POINT FOR SCHEMA CRM GET#
        XREF PROC DB$CLOK;   # PRIVACY LOCK TABLE NEW ENTRY BUILDER # 
        XREF PROC DB$CNSC;   # USE AN ENTRY NAME TO GET SCHEMA HEADER#
        XREF PROC DB$COPT;   # PROC OPTION TABLE NEW ENTRY MANAGER #
        XREF FUNC DB$CORD U; # FIND ORDINAL OF A DATA BASE PROCEDURE #
        XREF PROC DB$CPUT;   # PUT CORE WORDS IN THE MASTER DIRECTORY#
        XREF PROC DB$UADR;   # UPDATE MANAGED MEMORY USABLE ADDRESSES#
        XREF PROC DB$UAWS;   # ADJUST MANAGED MEMORY BLOCK WORK SPACE#
  
# UNLISTED DCLS UTCDF UTCIT UTMPT UTCAR UTCAS CUGBA CSTRC CSTOP CSTLK#
  
        CONTROL NOLIST;      # COMDECKS INDICATED ABOVE NOT LISTED #
*CALL UTCARDCLS 
*CALL UTCASDCLS 
*CALL CSTRCDCLS 
*CALL CSTOPDCLS 
*CALL CSTLKDCLS 
        CONTROL LIST;        # RESUME THE LISTING OF THE SOURCE CODE #
        CONTROL EJECT;
  
# THE FOLLOWING COMMON IS FOR DDL SUBSCHEMA AND SCHEMA HEADER ARRAYS #
  
        COMMON DB$CCAH; 
  
          BEGIN              # DB$CCAH COMMON BLOCK # 
  
# THE FOLLOWING FIXED ARRAY IS FOR SUBSCHEMA RECORD AND ITEM HEADERS #
  
          ARRAY SBHEADER[0:0] P(DFSBHEAD);       # SUBSCHEMA HEADER # 
  
          BEGIN              # SBHEADER ARRAY # 
  
*CALL SBRHDDCLS 
  
*CALL SBIHDDCLS 
  
          END                # SBHEADER ARRAY # 
        CONTROL EJECT;
  
# THE FOLLOWING FIXED ARRAY IS FOR THE SCHEMA RECORD AND ITEM HEADERS#
  
          ARRAY SCHEADER[0:0] P(DFSCHEAD);       # SCHEMA HEADER #
  
          BEGIN              # SCHEADER ARRAY # 
  
*CALL SCRHDDCLS 
  
*CALL SCIHDDCLS 
  
          END                # SCHEADER ARRAY # 
  
          END                # DB$CCAH COMMON BLOCK # 
        CONTROL EJECT;
  
# THE FOLLOWING ITEMS ARE LOCAL TO DB$CREC #
  
        ITEM INDEX I;        # A GENERAL INDEX AND INDUCTION VARIABLE#
        ITEM ITLOCKEN U;     # ITEM LOCK ENTRY (USED AS SCRATCH WORD)#
        ITEM ITNEEDED B;     # CERTAIN ITEM PROCESSING NEEDED FLAG #
        ITEM ITNOLOCK B;     # TRUE IFF NO ITEM HAS A PRIVACY LOCK #
        ITEM ITORDINL U;     # ITEM ORDINAL IN THE SUBSCHEMA #
        ITEM ITPOINTR U;     # ITEM PRIVACY LOCK FLAG TABLE POINTER # 
        ITEM ITSBCURR U;     # SUBSCHEMA CURRENT ITEM ENTRY ADDRESS # 
        ITEM ITSBNEXT U;     # SUBSCHEMA NEXT ITEM ENTRY WORD ADDRESS#
        ITEM ITSBNUMB U;     # SUBSCHEMA NUMBER OF ITEMS IN RECORD #
        ITEM ITSCCURR U;     # SCHEMA CURRENT ITEM ENTRY WORD ADDRESS#
        ITEM TEMPUNS U;      # A TEMPORARY UNSIGNED INTEGER VARIABLE #
  
# FOLLOWING LOCAL BASED ARRAY FOR SUBSCHEMA ITEM PRIVACY LOCK OPTIONS#
  
        BASED ARRAY SBITPRIV;          # SUBSCHEMA ITEM PRIVACY LOCK #
  
          BEGIN              # SBITPRIV BASED ARRAY # 
  
*CALL SBIPRDCLS 
  
          END                # SBITPRIV BASED ARRAY # 
  
# FOLLOWING LOCAL BASED ARRAY FOR SUBSCHEMA RECORD PRIVACY LOCK ENTRY#
  
        BASED ARRAY SBRDPRIV;          # SUBSCHEMA RECORD PRIVACY # 
  
          BEGIN              # SBRDPRIV BASED ARRAY # 
  
*CALL SBRPRDCLS 
  
          END                # SBRDPRIV BASED ARRAY # 
        CONTROL EJECT;
  
# FOLLOWING LOCAL BASED ARRAY FOR SCHEMA ITEM PRIVACY LOCK OPTIONS #
  
        BASED ARRAY SCITPRIV;          # SCHEMA ITEM PRIVACY LOCK # 
  
          BEGIN              # SCITPRIV BASED ARRAY # 
  
*CALL SCIPRDCLS 
  
          END                # SCITPRIV BASED ARRAY # 
  
# FOLLOWING LOCAL BASED ARRAY FOR SCHEMA RECORD CALL PROC OPTIONS # 
  
        BASED ARRAY SCRDCALL;          # SCHEMA RECORD CALL OPTIONS # 
  
          BEGIN              # SCRDCALL BASED ARRAY # 
  
*CALL SCRCLDCLS 
  
          END                # SCRDCALL BASED ARRAY # 
  
# FOLLOWING LOCAL BASED ARRAY FOR SCHEMA RECORD PRIVACY LOCK OPTIONS #
  
        BASED ARRAY SCRDPRIV;          # SCHEMA RECORD PRIVACY LOCK # 
  
          BEGIN              # SCRDPRIV BASED ARRAY # 
  
*CALL SCRPRDCLS 
  
          END                # SCRDPRIV BASED ARRAY # 
        CONTROL EJECT;
  
# CALL DB$CGSB TO GET NEXT SUBSCHEMA RECORD HEADER.  ABORT ON ERROR. #
  
        IF SBCURRAD EQ SBNEXTAD        # CURRENT AND NEXT ADDRESSES # 
          THEN XCALL DB$CERR("7801CREC",SBCURRAD);         # ABORT #
        XCALL DB$CGSB(LOC(SBHEADER),DFSBHEAD,SBNEXTAD);    # GET HEAD#
        SBCURRAD = SBNEXTAD;           # SUBSCHEMA CURRENT ADDRESS #
        SBNEXTAD = SBNEXTAD + SBRECNXRECP[0];    # SUBSCHEMA NEXT ADD#
        IF SBRECTYPE[0] NQ 2           # IF ENTRY TYPE IS NOT 2 (REC)#
          THEN XCALL DB$CERR("7802CREC",SBRECTYPE[0]);     # ABORT #
        XCALL DB$CGSB(SUBSADDR,DFNAMEWD,SBCURRAD + SBRECNAMEPTR[0]);
        P<GETENTRY> = SUBSADDR;        # POINT TO SUBSCHEMA REC NAME #
        CURSCRAT = GETWDTHR[0];        # AVOID A SYMPL COMPILER ERROR#
        CURNAME = DB$CFIL(CURSCRAT,SBRECNMELENC[0]," ");   # " "-FILL#
  
# CALL DB$CNSC TO GET RELATED SCHEMA RECORD HEADER.  ABORT ON ERROR. #
  
        IF SBRECALIASP[0] GR 0         # IF THERE IS A RECORD ALIAS # 
          THEN               # GET SCHEMA RECORD HEADER USING ALIAS # 
            BEGIN 
              XCALL          # GET REC ALIAS NAME (= NAME IN SCHEMA) #
                DB$CGSB(SUBSADDR,DFNAMEWD,SBCURRAD + SBRECALIASP[0]); 
              XCALL DB$CNSC(1,SBRECALIASLW[0]);            # GET HEAD#
            END 
          ELSE XCALL DB$CNSC(1,SBRECNMELENW[0]);           # GET HEAD#
        IF SCRECDATATYP[0] NQ 7        # IF ENTRY TYPE IS NOT 7 (REC)#
          THEN XCALL DB$CERR("7803CREC",SCRECDATATYP[0]);  # ABORT #
  
# FILL IN THE RECORD WORK BLOCK USING INFO IN CORE.  ABORT ON ERROR. #
  
        WOCURENT = DFRECWRK + SBRECNMELENW[0]    # WORK BLOCK LENGTH #
                   + (SBRECNBRITMS[0] + (DFITLKWD - 1)) / DFITLKWD; 
        XCALL DB$UAWS(LOC(WORPOINT),WOCURENT);   # ADJUST WORK SPACE #
        P<CSRECBLK> = WORKADDR;        # POINT TO WORK BLOCK IN CORE #
        CSRDPCHK[0] = SCRECDBPCKFG[0]; # TRUE IFF ITEM DBP OR CHECK # 
        CSRSAME[0] = SBRECIDNTICL[0];  # TRUE IF SCH REC = SUBSCH REC#
        CSRNOMAP[0] = NOT (SCRECDBPCKFG[0] OR NOT SBRECIDNTICL[0] 
                           OR SCRECAVAR[0] OR SCRECAVVR[0]);
        CSRACRES[0] = SCRECAVAR[0];    # TRUE IFF ACTUAL RESULT # 
        CSRVIRES[0] = SCRECAVVR[0];    # TRUE IFF VIRTUAL RESULT #
        CSRNAMLW[0] = SBRECNMELENW[0]; # RECORD NAME LENGTH IN WORDS #
        CSRLOCK[0] = LNO 0;            # LOCK DEFAULT IS ALL ONE BITS#
        CSRWITHN[0] = SBRECWITHINO[0]; # WITHIN AREA ORDINAL #
        CSRSBITM[0] = SBRECNBRITMS[0]; # NUMBER OF SUBSCHEMA ITEMS #
        CSRSBLEN[0] = SBRECLENGTH[0];  # SUBSCHEMA REC LENGTH IN CHAR#
        CSRSCITM[0] = SCRNUMITEMS[0];  # NUMBER OF SCHEMA ITEMS # 
        CSRSCLEN[0] = SCRECLENGTH[0];  # SCHEMA RECORD LENGTH IN CHAR#
        IF SCMAXREC LS SCRECLENGTH[0] THEN SCMAXREC = SCRECLENGTH[0]; 
        IF CSRNAMLW[0] NQ SBRECNMELENW[0]        # IF LENGTH TRUNCATE#
          THEN XCALL DB$CERR("7804CREC",SBRECNMELENW[0]);  # ABORT #
        IF CSRSBITM[0] NQ SBRECNBRITMS[0]        # IF NUMBER TRUNCATE#
          THEN XCALL DB$CERR("7805CREC",SBRECNBRITMS[0]);  # ABORT #
        IF CSRSBLEN[0] NQ SBRECLENGTH[0]         # IF LENGTH TRUNCATE#
          THEN XCALL DB$CERR("7806CREC",SBRECLENGTH[0]);   # ABORT #
        IF CSRSCITM[0] NQ SCRNUMITEMS[0]         # IF NUMBER TRUNCATE#
          THEN XCALL DB$CERR("7807CREC",SCRNUMITEMS[0]);   # ABORT #
        IF CSRSCLEN[0] NQ SCRECLENGTH[0]         # IF LENGTH TRUNCATE#
          THEN XCALL DB$CERR("7808CREC",SCRECLENGTH[0]);   # ABORT #
        IF SBRECRDCAPA[0] GR 0         # CHECK READ CAPSULE POINTER # 
          THEN               # PROCESS SUBSCHEMA CAPSULE INFORMATION #
            BEGIN 
              CSRRCAPL[0] = SBRECRDCAPL[0];      # CAPSULE WRD LENGTH#
              CSRRCAPP[0] = 1 + SBRECRDCAPA[0] - SBFIRCAP; # POINTER #
              MCLENREC = MCLENREC + SBRECRDCAPL[0];        # LENGTH # 
              MCNUMREC = MCNUMREC + 1;           # REC CAPSULE COUNT #
              IF CSRRCAPL[0] NQ SBRECRDCAPL[0]   # IF LENGTH TRUNCATE#
                THEN XCALL DB$CERR("7809CREC",SBRECRDCAPL[0]); #ABORT#
              IF CSRRCAPP[0] NQ 1 + SBRECRDCAPA[0] - SBFIRCAP 
                THEN XCALL DB$CERR("7810CREC",SBRECRDCAPA[0]); #ABORT#
            END 
        IF SBRECWRCAPA[0] GR 0         # CHECK WRITE CAPSULE POINTER #
          THEN               # PROCESS SUBSCHEMA CAPSULE INFORMATION #
            BEGIN 
              CSRWCAPL[0] = SBRECWRCAPL[0];      # CAPSULE WRD LENGTH#
              CSRWCAPP[0] = 1 + SBRECWRCAPA[0] - SBFIRCAP; # POINTER #
              MCLENREC = MCLENREC + SBRECWRCAPL[0];        # LENGTH # 
              MCNUMREC = MCNUMREC + 1;           # REC CAPSULE COUNT #
              IF CSRWCAPL[0] NQ SBRECWRCAPL[0]   # IF LENGTH TRUNCATE#
                THEN XCALL DB$CERR("7811CREC",SBRECWRCAPL[0]); #ABORT#
              IF CSRWCAPP[0] NQ 1 + SBRECWRCAPA[0] - SBFIRCAP 
                THEN XCALL DB$CERR("7812CREC",SBRECWRCAPA[0]); #ABORT#
            END 
        C<0,SBRECNMELENW[0] * DFCHARWD> CSRNAME[0] = CURNAME; 
  
# IF THERE IS SCHEMA DB PROC OPTION INFO, PROCESS IT USING DB$COPT #
  
        IF SCRECONLIST[0] GR 0         # SCHEMA CALL DBP LIST POINTER#
          THEN               # PROCESS SCHEMA DB PROC OPTION INFO # 
            BEGIN 
              XCALL          # GET SCHEMA CALL DB PROC OPTION LIST #
                DB$CGSC(SCHEADDR,SCMAXENT,SCCURRAD + SCRECONLIST[0]); 
              WRKPOWRD[0] = 0;         # WORK BLOCK PROC OPTION POINT#
              P<CSOPTTBL> = LOC(OPTNDATA);       # PROC OPTION ARRAY #
              INDEX = 0;     # IN THE NEXT LOOP, INDEX IS AN OFFSET # 
              LOOP WHILE INDEX GQ 0 DO           # LOOP IS A FOR DEF #
                BEGIN 
                  P<SCRDCALL> = SCHEADDR + INDEX;          # SCHEMA # 
                  P<CSRECBLK> = WORKADDR;        #POINT TO WORK BLOCK#
                  CSRPOADE[0] = CSRPOADE[0] OR   # AFTER DELETE FLAG #
                                (SCRDCALLAFT[0] AND SCRDCALLDEL[0]);
                  CSRPOBDE[0] = CSRPOBDE[0] OR   # BEFORE DELETE FLAG#
                                (SCRDCALLBEF[0] AND SCRDCALLDEL[0]);
                  CSRPOEDE[0] = CSRPOEDE[0] OR   # ERROR DELETE FLAG #
                                (SCRDCALLERR[0] AND SCRDCALLDEL[0]);
                  CSRPOAFI[0] = CSRPOAFI[0] OR   # AFTER FIND FLAG #
                                (SCRDCALLAFT[0] AND SCRDCALLFIN[0]);
                  CSRPOBFI[0] = CSRPOBFI[0] OR   # BEFORE FIND FLAG # 
                                (SCRDCALLBEF[0] AND SCRDCALLFIN[0]);
                  CSRPOEFI[0] = CSRPOEFI[0] OR   # ERROR FIND FLAG #
                                (SCRDCALLERR[0] AND SCRDCALLFIN[0]);
                  CSRPOAGE[0] = CSRPOAGE[0] OR   # AFTER GET FLAG # 
                                (SCRDCALLAFT[0] AND SCRDCALLGET[0]);
                  CSRPOBGE[0] = CSRPOBGE[0] OR   # BEFORE GET FLAG #
                                (SCRDCALLBEF[0] AND SCRDCALLGET[0]);
                  CSRPOEGE[0] = CSRPOEGE[0] OR   # ERROR GET FLAG # 
                                (SCRDCALLERR[0] AND SCRDCALLGET[0]);
                  CSRPOAMO[0] = CSRPOAMO[0] OR   # AFTER MODIFY FLAG #
                                (SCRDCALLAFT[0] AND SCRDCALLMOD[0]);
                  CSRPOBMO[0] = CSRPOBMO[0] OR   # BEFORE MODIFY FLAG#
                                (SCRDCALLBEF[0] AND SCRDCALLMOD[0]);
                  CSRPOEMO[0] = CSRPOEMO[0] OR   # ERROR MODIFY FLAG #
                                (SCRDCALLERR[0] AND SCRDCALLMOD[0]);
                  CSRPOAST[0] = CSRPOAST[0] OR   # AFTER STORE FLAG # 
                                (SCRDCALLAFT[0] AND SCRDCALLSTO[0]);
                  CSRPOBST[0] = CSRPOBST[0] OR   # BEFORE STORE FLAG #
                                (SCRDCALLBEF[0] AND SCRDCALLSTO[0]);
                  CSRPOEST[0] = CSRPOEST[0] OR   # ERROR STORE FLAG # 
                                (SCRDCALLERR[0] AND SCRDCALLSTO[0]);
                  CSOWORD[0] = 0;      # PROC OPTION TABLE ENTRY WORD#
                  CSORPORD[0] = DB$CORD(SCRECONPROCN[0],DFSCFLAG);
                  CSORRCAF[0] = SCRDCALLAFT[0];  # DBP AFTER FLAG # 
                  CSORRCBE[0] = SCRDCALLBEF[0];  # DBP BEFORE FLAG #
                  CSORRCOE[0] = SCRDCALLERR[0];  # DBP ON ERROR FLAG #
                  CSORRCDE[0] = SCRDCALLDEL[0];  # DBP DELETE FLAG #
                  CSORRCFI[0] = SCRDCALLFIN[0];  # DBP FIND FLAG #
                  CSORRCGE[0] = SCRDCALLGET[0];  # DBP GET FLAG # 
                  CSORRCMO[0] = SCRDCALLMOD[0];  # DBP MODIFY FLAG #
                  CSORRCST[0] = SCRDCALLSTO[0];  # DBP STORE FLAG # 
                  IF SCRECNEXTON[0]              # IF ANOTHER ENTRY # 
                    THEN INDEX = INDEX + 1;      # NEXT ENTRY OFFSET #
                    ELSE INDEX = -1;             # TERMINATE DBP LOOP#
                  XCALL DB$COPT;       # PROC OPTION TABLE MANAGER #
                END 
              P<CSRECBLK> = WORKADDR;            #POINT TO WORK BLOCK#
              CSRPOPNT[0] = WRKPOPNT[0];         # PROC OPTION POINTR#
            END 
  
# IF THERE IS SUBSCHEMA LOCK INFORMATION, PROCESS IT USING DB$CLOK #
  
        IF SBRECPRIVPTR[0] GR 0        # CHECK SUBSCHEMA LOCK POINTER#
          THEN               # PROCESS SUBSCHEMA PRIVACY LOCK INFO #
            BEGIN 
              SBGETFWA = SBCURRAD + SBRECPRIVPTR[0];       # LOCK FWA#
              P<CSLOKTBL> = LOC(LOCKDATA);       # PRIVACY LOCK ARRAY#
              LOOP WHILE SBGETFWA GR 0 DO        # DB$CLOK RESETS FWA#
                BEGIN 
                  XCALL DB$CGSB(SUBSADDR,SBMAXENT,SBGETFWA);
                  P<SBRDPRIV> = SUBSADDR;        # POINT TO SUBSCHEMA#
                  CSLKWORD[0] = 0;     # PRIVACY LOCK TABLE WORD #
                  CSLKRCOP[0] = LNO 0; # LOCK DEFAULT IS ALL ONE BITS#
                  CSLKRCDE[0] = NOT SBRDPRIVDEL[0];        # DELETE # 
                  CSLKRCFI[0] = NOT SBRDPRIVFIN[0];        # FIND # 
                  CSLKRCGE[0] = NOT SBRDPRIVGET[0];        # GET #
                  CSLKRCMO[0] = NOT SBRDPRIVMOD[0];        # MODIFY # 
                  CSLKRCST[0] = NOT SBRDPRIVSTO[0];        # STORE #
                  CSLKTYPE[0] = CURTYPE;         # REC ELEMENT TYPE # 
                  CSLKGORD[0] = CURORDNL;        # ORDINAL OF RECORD #
                  P<CSRECBLK> = WORKADDR;        #POINT TO WORK BLOCK#
                  CSRLOCK[0] = CSRLOCK[0] LAN CSLKRCOP[0]; #LOGIC AND#
                  XCALL DB$CLOK(DFSBFLAG);       # SUBSCHEMA LOCK # 
                END 
            END 
  
# IF THERE IS ONLY SCHEMA LOCK INFORMATION, PROCESS IT USING DB$CLOK #
  
        IF SBRECPRIVPTR[0] EQ 0 AND SCRECPRIVPTR[0] GR 0   # ONLY SCH#
          THEN               # PROCESS SCHEMA PRIVACY LOCK INFORMATN.#
            BEGIN 
              SCGETFWA = SCCURRAD + SCRECPRIVPTR[0];       # LOCK FWA#
              P<CSLOKTBL> = LOC(LOCKDATA);       # PRIVACY LOCK ARRAY#
              LOOP WHILE SCGETFWA GR 0 DO        # DB$CLOK RESETS FWA#
                BEGIN 
                  XCALL DB$CGSC(SCHEADDR,SCMAXENT,SCGETFWA);
                  P<SCRDPRIV> = SCHEADDR;        # POINT TO SCHEMA #
                  CSLKWORD[0] = 0;     # PRIVACY LOCK TABLE WORD #
                  CSLKRCOP[0] = LNO 0; # LOCK DEFAULT IS ALL ONE BITS#
                  CSLKRCDE[0] = NOT SCRDPRIVDEL[0];        # DELETE # 
                  CSLKRCFI[0] = NOT SCRDPRIVFIN[0];        # FIND # 
                  CSLKRCGE[0] = NOT SCRDPRIVGET[0];        # GET #
                  CSLKRCMO[0] = NOT SCRDPRIVMOD[0];        # MODIFY # 
                  CSLKRCST[0] = NOT SCRDPRIVSTO[0];        # STORE #
                  CSLKTYPE[0] = CURTYPE;         # REC ELEMENT TYPE # 
                  CSLKGORD[0] = CURORDNL;        # ORDINAL OF RECORD #
                  P<CSRECBLK> = WORKADDR;        #POINT TO WORK BLOCK#
                  CSRLOCK[0] = CSRLOCK[0] LAN CSLKRCOP[0]; #LOGIC AND#
                  XCALL DB$CLOK(DFSCFLAG);       # SCHEMA LOCK ENTRY #
                END 
            END 
  
# PREPARE TO PROCESS ITEM INFORMATION BY DOING NEEDED INITIALIZATIONS#
  
        ITNOLOCK = TRUE;     # TRUE MEANS NO ITEM HAS A PRIVACY LOCK #
        ITPOINTR = DFRECWRK + SBRECNMELENW[0];   # ITEM LOCK POINTER #
        ITSBCURR = 0;        # SUBSCHEMA CURRENT ITEM ENTRY ADDRESS # 
        ITSBNEXT = SBCURRAD + SBRECNXITEMP[0];   # SUBSCHEMA 1ST ITEM#
        ITSBNUMB = SBRECNBRITMS[0];              # SUBSCHEMA NUMBER # 
        P<CSRILOCK> = LOC(ITLOCKEN);             # ITEM LOCK ENTRY #
        TEMPUNS = WOCURENT - ITPOINTR;           # LOCK TABLE WORDS # 
        P<PUTENTRY> = WORKADDR + ITPOINTR - 1;   # POINT TO TABLE - 1#
        FOR INDEX = 1 THRU TEMPUNS DO PUTUNSIG[INDEX] = LNO 0;
  
# PROCESS ITEM INFORMATION, STARTING WITH GETTING ITEM ENTRY HEADERS #
  
        CURTYPE = 3;         # CURRENT DATA BASE ELEMENT TYPE IS ITEM#
        FOR ITORDINL = 1 THRU ITSBNUMB DO        # LOOP THROUGH ITEMS#
          BEGIN              # MAJOR LOOP FOR ITEM INFO PROCESSING #
            ITNEEDED = TRUE;           # NEED TO READ SUBSCHEMA ITEM #
            LOOP WHILE ITNEEDED DO     # LOOP UNTIL NON-LEVEL-88 READ#
              BEGIN 
                XCALL DB$CGSB(LOC(SBHEADER),DFSBHEAD,ITSBNEXT); 
                ITSBCURR = ITSBNEXT;             # CURRENT ITEM ADDRS#
                ITSBNEXT = ITSBNEXT + SBITMENTRYL[0];      #NEXT ITEM#
                IF SBITMLEVEL[0] NQ O"64" THEN ITNEEDED = FALSE;
              END 
            IF SBITMREDEFFG[0] OR SBITMLEVEL[0] EQ O"62"   # REDEFINE#
              OR SBITMTYPE[0] EQ 0     # RENAME OR NONREPEATING GROUP#
                THEN ITSCCURR = 0;     # NO CURRENT ITEM SCHEMA ENTRY#
                ELSE         # THERE IS A CORRESPONDING SCHEMA ITEM # 
                  BEGIN 
                    IF SBITMALIASP[0] GR 0       # IF AN ITEM ALIAS # 
                      THEN             # GET THE ITEM ALIAS NAME #
                        BEGIN 
                          XCALL DB$CGSB(SUBSADDR,DFNAMEWD,
                                        ITSBCURR + SBITMALIASP[0]); 
                          TEMPUNS = SBITMALIASLW[0];       # LENGTH # 
                        END 
                      ELSE             # GET THE ITEM NON-ALIAS NAME #
                        BEGIN 
                          XCALL DB$CGSB(SUBSADDR,DFNAMEWD,
                                        ITSBCURR + SBITMNAMEPTR[0]);
                          TEMPUNS = SBITMNELENW[0];        # LENGTH # 
                        END 
                    P<GETENTRY> = SUBSADDR;      # POINT TO SUBSCHEMA#
                    CURSCRAT = GETWDTHR[0];      # SCHEMA ITEM NAME # 
                    XCALL DE$DISC(SCCWDDIT,SCCURRAD,CURSCRAT,TEMPUNS, 
                                  DFSCHEAD,SCHEADER);      # GET HEAD#
                    P<DIRACCES> = LOC(SCCWDDIT);           #DIT ARRAY#
                    IF DASTATE[0] EQ 1 OR DASTATE[0] EQ 2  #DIT STATE#
                      THEN             # IF A NON-CRM ERROR, ABORT #
                        XCALL DB$CERR("7813CREC",TEMPUNS * DFCHARWD); 
                    IF DASTATE[0] NQ 0 THEN XCALL DB$CESC; #CRM ERROR#
                    XCALL DB$UADR;     # UPDATE MANAGED MEM ADDRESSES#
                    ITSCCURR = DAENTAD[0];       # CURRENT ADDRESS #
                  END 
            CSRILKEN[0] = LNO 0;       # LOCK DEFAULT IS ALL ONE BITS#
  
# IF THERE IS SUBSCHEMA ITEM LOCK INFO, PROCESS IT USING DB$CLOK #
  
            IF SBITMPRIVPTR[0] GR 0    # SUBSCHEMA ITEM LOCK POINTER #
              THEN           # PROCESS SUBSCHEMA ITEM LOCK INFORMATN.#
                BEGIN 
                  ITNEEDED = TRUE;     # NEED TO HAVE ITEM LOCK INFO #
                  SBGETFWA = ITSBCURR + SBITMPRIVPTR[0];   # LOCK FWA#
                  P<CSLOKTBL> = LOC(LOCKDATA);             #LOCK ARAY#
                  LOOP WHILE SBGETFWA GR 0 DO              #FWA RESET#
                    BEGIN 
                      XCALL DB$CGSB(SUBSADDR,SBMAXENT,SBGETFWA);
                      P<SBITPRIV> = SUBSADDR;    # POINT TO SUBSCHEMA#
                      CSLKWORD[0] = 0;           # PRIVACY LOCK WORD #
                      CSLKITOP[0] = LNO 0;       # DEFAULT ALL 1 BITS#
                      CSLKITGE[0] = NOT SBITPRIVGET[0];    # GET #
                      CSLKITMO[0] = NOT SBITPRIVMOD[0];    # MODIFY # 
                      CSLKITST[0] = NOT SBITPRIVSTO[0];    # STORE #
                      CSLKTYPE[0] = CURTYPE;     # ITEM ELEMENT TYPE #
                      CSLKGORD[0] = CURORDNL;    # ORDINAL OF RECORD #
                      CSLKLORD[0] = ITORDINL;    # ORDINAL OF ITEM #
                      CSRILKGE[0] = CSRILKGE[0] AND CSLKITGE[0];
                      CSRILKMO[0] = CSRILKMO[0] AND CSLKITMO[0];
                      CSRILKST[0] = CSRILKST[0] AND CSLKITST[0];
                      XCALL DB$CLOK(DFSBFLAG);   # SUBSCHEMA LOCK # 
                    END 
                END 
  
# IF THERE IS ONLY SCHEMA ITEM LOCK INFO, PROCESS IT USING DB$CLOK #
  
            IF SBITMPRIVPTR[0] EQ 0 AND SCITEMPRIVP[0] GR 0 
              AND ITSCCURR GR 0        # IF ONLY SCHEMA ITEM LOCK # 
                THEN         # PROCESS SCHEMA ITEM LOCK INFORMATION # 
                  BEGIN 
                    ITNEEDED = TRUE;   # NEED TO HAVE ITEM LOCK INFO #
                    SCGETFWA = ITSCCURR + SCITEMPRIVP[0];  # LOCK FWA#
                    P<CSLOKTBL> = LOC(LOCKDATA);           #LOCK ARAY#
                    LOOP WHILE SCGETFWA GR 0 DO            #FWA RESET#
                      BEGIN 
                        XCALL DB$CGSC(SCHEADDR,SCMAXENT,SCGETFWA);
                        P<SCITPRIV> = SCHEADDR;  # POINT TO SCHEMA #
                        CSLKWORD[0] = 0;         # PRIVACY LOCK WORD #
                        CSLKITOP[0] = LNO 0;     # DEFAULT ALL 1 BITS#
                        CSLKITGE[0] = NOT SCITPRIVGET[0];  # GET #
                        CSLKITMO[0] = NOT SCITPRIVMOD[0];  # MODIFY # 
                        CSLKITST[0] = NOT SCITPRIVSTO[0];  # STORE #
                        CSLKTYPE[0] = CURTYPE;             # DBE TYPE#
                        CSLKGORD[0] = CURORDNL;            # REC ORDN#
                        CSLKLORD[0] = ITORDINL;            # ITEM ORD#
                        CSRILKGE[0] = CSRILKGE[0] AND CSLKITGE[0];
                        CSRILKMO[0] = CSRILKMO[0] AND CSLKITMO[0];
                        CSRILKST[0] = CSRILKST[0] AND CSLKITST[0];
                        XCALL DB$CLOK(DFSCFLAG);           # SCH LOCK#
                      END 
                  END 
  
# IF NON-DEFAULT ITEM LOCK INFO NEEDED, PUT IT IN THE ITEM LOCK TABLE#
  
            IF ITNEEDED      # IF NON-DEFAULT ITEM LOCK INFO NEEDED # 
              THEN           # PUT ITEM LOCK INFO IN ITEM LOCK TABLE #
                BEGIN 
                  ITNOLOCK = FALSE;              # SOME ITEM HAS LOCK#
                  TEMPUNS = (ITORDINL - 1) / DFITLKWD;     # WORD # 
                  P<PUTENTRY> = WORKADDR + ITPOINTR + TEMPUNS;
                  TEMPUNS = DFBITSWD - (DFITLKLN * (ITORDINL
                                        - (TEMPUNS * DFITLKWD))); 
                  B<TEMPUNS,DFITLKLN> PUTUNSIG[0] = CSRILKEN[0];
                END 
          END                # MAJOR LOOP FOR ITEM INFO PROCESSING #
  
# FILL IN THE REMAINING RECORD WORK BLOCK FIELDS.  ABORT ON ERROR. #
  
        CURTYPE = 2;         # CURRENT DATA BASE ELEMENT TYPE IS REC #
        IF ITNOLOCK          # CHECK IF NO ITEM HAS A PRIVACY LOCK #
          THEN               # REMOVE ITEM PRIVACY LOCK FLAG TABLE #
            BEGIN 
              XCALL DB$UAWS(LOC(WORPOINT),ITPOINTR - WOCURENT); 
              WOCURENT = ITPOINTR;     # DECREASE WORK BLOCK LENGTH # 
            END 
          ELSE               # SET POINTER TO ITEM PRIVACY LOCK TABLE#
            BEGIN 
              P<CSRECBLK> = WORKADDR;            #POINT TO WORK BLOCK#
              CSRILKPT[0] = ITPOINTR;            # ITEM LOCK POINTER #
              LENILOCK = LENILOCK + WOCURENT - ITPOINTR;
              IF CSRILKPT[0] NQ ITPOINTR         # IF POINTR TRUNCATE#
                THEN XCALL DB$CERR("7814CREC",ITPOINTR);   # ABORT #
            END 
        P<CSRECBLK> = WORKADDR;        # POINT TO WORK BLOCK IN CORE #
        CSRLENTH[0] = WOCURENT;        # LENGTH OF RECORD WORK BLOCK #
        IF CSRLENTH[0] NQ WOCURENT     # CHECK IF LENGTH IS TRUNCATED#
          THEN XCALL DB$CERR("7815CREC",WOCURENT);         # ABORT #
  
# CALL DB$CPUT TO PUT IN THE MD.  CALL DB$UAWS TO ADJUST WORK SPACE. #
  
        XCALL DB$CPUT(WORKADDR,WOCURENT);        # WRITE TO MD FILE # 
        XCALL DB$UAWS(LOC(WORPOINT),-WOCURENT);  # ADJUST WORK SPACE #
        WOCURENT = 0;        # WORK BLOCK CURRENT LENGTH IN WORDS # 
  
# RESET SOME ITEMS IN COMMON WHICH RELATE TO THE CURRENT ACTIVITY # 
  
        CURNAME = " ";       # CURRENT DATA BASE ELEMENT NAME - NONE #
        CURSCRAT = " ";      # CURRENT SCRATCH USE NAME # 
  
# RETURN FROM DB$CREC WITH THE NEW RECORD WORK BLOCK NOW IN THE MD #
  
        RETURN;              # NEW RECORD WORK BLOCK NOW IN THE MD #
  
        END                  # DB$CREC #
  
      TERM
