*COMDECK     COMDDLCG   - DATA DESCRIPTION LANGUAGE CODE GENERATOR. 
#*        DDLCG  -  DATA DESCRIPTION LANGUAGE CODE GENERATOR. 
* 
*         R. H. GOODELL.     76/06/17.
* 
*         THIS IS THE MAIN PROGRAM OF THE *DDL* CODE GENERATOR
*         OVERLAY.  IT IS CALLED AFTER A (COBOL, FORTRAN, ...)
*         SUB-SCHEMA COMPILER HAS FINISHED PROCESSING ITS SOURCE
*         INPUT AND HAS PRODUCED A SUB-SCHEMA DIRECTORY THAT IS 
*         COMPLETE EXCEPT FOR THE CODE CAPSULES TO BE EXECUTED
*         BY *CDCS* AS PART OF ITS RECORD MAPPER.  THE CODE 
*         GENERATOR USES THE SUB-SCHEMA DIRECTORY AND THE SCHEMA
*         DIRECTORY TO CREATE KEY AND RECORD MAPPING CAPSULES,
*         AND APPENDS THEM TO THE SUB-SCHEMA DIRECTORY.  THIS 
*         CODE GENERATOR OVERLAY IS FOLLOWED BY THE SUB-SCHEMA
*         LIBRARY MAINTENANCE OVERLAY, WHICH STORES THE FINISHED
*         SUB-SCHEMA DIRECTORY JUST COMPILED INTO THE SUB-SCHEMA
*         LIBRARY FILE WHERE IT CAN BE ACCESSED BY APPLICATION
*         PROGRAMMING LANGUAGE COMPILERS AND BY *CDCS*. 
* 
*         THE CODE GENERATOR PRODUCES TWO RECORD MAPPING CAPSULES 
*         (ONE FOR READING AND ONE FOR WRITING/REWRITING) FOR EACH
*         RECORD TYPE THAT IS IN THE SUB-SCHEMA AND NEEDS MAPPING.
*         THERE ARE NO RECORD MAPPING CAPSULES FOR A NO-MAP RECORD
*         TYPE.  THE CODE GENERATOR ALSO PRODUCES ONE KEY MAPPING 
*         CAPSULE FOR EACH REALM THAT IS IN THE SUB-SCHEMA AND HAS
*         KEY ITEMS THAT REQUIRE MAPPING.  KEY ITEMS CAN BE IN ANY
*         RECORD TYPE IN THE REALM.  THERE IS NO KEY MAPPING CAPSULE
*         IF THE REALM HAS NO KEY ITEMS THAT NEED MAPPING.
* 
*         EACH CAPSULE IS GENERATED BY A TWO PASS PROCESS.  PASS 1
*         READS ITEM ENTRIES ONE AT A TIME IN THE SCHEMA AND SUB- 
*         SCHEMA DIRECTORIES, AND GENERATES CODE TO DO CONVERSION 
*         AND/OR REFORMATTING OF EACH ITEM AND TO CALL ITEM-LEVEL 
*         DATA BASE PROCEDURES AS NEEDED.  *OCCURS* CLAUSES RESULT
*         IN THE GENERATION OF LOOP CONTROL CODE.  ALL GENERATED
*         CODE IS STORED IN TABLES IN THE FORM OF A SEMI-SYMBOLIC 
*         INTERMEDIATE LANGUAGE.  PASS 2 THEN REFORMATS THIS CODE 
*         INTO CAPSULE FORMAT AS REQUIRED BY THE *FAST DYNAMIC* OR
*         CAPSULE LOADER.  OPTIONALLY, PASS 2 CAN ALSO PRODUCE A
*         LISTING OF THE OBJECT CODE IN A COMPASS-LIKE NOTATION.
* 
*         WHEN CORRESPONDING DATA ITEMS ARE IN A DIFFERENT ORDER
*         IN THE SCHEMA AND SUB-SCHEMA, THE ORDER IN WHICH THE
*         GENERATED RECORD MAPPING OBJECT CODE PROCESSES THE ITEMS
*         IS DETERMINED BY THE FACT THAT STORE INSTRUCTIONS TAKE
*         LONGER TO EXECUTE THAN FETCH INSTRUCTIONS.  THEREFORE,
*         ONE GOAL OF THE CODE GENERATION METHOD IS TO MINIMISE 
*         THE NUMBER OF STORE INSTRUCTIONS PRODUCED, EVEN IF
*         THIS RESULTS IN SOME REDUNDANT FETCH INSTRUCTIONS.
*         TO ACHIEVE THIS, THE OBJECT CODE PROCESSES DATA ITEMS 
*         IN THE ORDER IN WHICH THEY OCCUR IN THE TARGET RECORD 
*         DESCRIPTION.
* 
*         KEY ITEMS ARE MAPPED INDEPENDENTLY OF EACH OTHER AND
*         THE DISCUSSION ABOVE DOES NOT APPLY.  A KEY MAPPING 
*         CAPSULE CONTAINS ONE OR MORE SEPARATE ROUTINES, ONE FOR 
*         EACH UNIQUE PRIMARY OR ALTERNATE OR MAJOR KEY ITEM OR 
*         RECORD QUALIFIER, PLUS ONE ROUTINE TO SELECT ONE OF 
*         THEM.  THE OBJECT CODE IN EACH KEY ITEM MAPPING 
*         ROUTINE IS ESSENTIALLY THE SAME AS THE CODE FOR THAT
*         ITEM IN THE WRITE/REWRITE RECORD MAPPING CODE CAPSULE 
*         AND IS PRODUCED BY THE SAME CODE GENERATING ROUTINES. 
# 
  
  
  
*CALL     COMDDEF            GENERAL DEFINITIONS. 
  
     STATUS  MAP  KEY, READ, WRITE ;         # *MAPX* VALUES #
  
  
#*        MANAGED TABLE POINTERS. 
* 
*         THE CODE GENERATOR USES A NUMBER OF TABLES FOR STORING
*         INTERMEDIATE RESULTS AND OTHER DATA.  ALL OF THESE TABLES 
*         ARE IN CENTRAL MEMORY ALL OF THE TIME, AND MOST ARE FULLY 
*         DYNAMIC IN BOTH SIZE AND LOCATION.  ALL CHANGES IN SIZE 
*         OF THE DYNAMIC TABLES ARE HANDLED BY A CENTRAL ROUTINE
*         *MANAGER* WHICH MOVES TABLES AROUND IN MEMORY AND/OR
*         INCREASES THE JOB FIELD LENGTH AS NEEDED.  ALL REFERENCES 
*         TO MANAGED TABLES ARE INDIRECT THROUGH THEIR POINTER WORDS
*         (THAT IS, IN SYMPL TERMINOLOGY, THEY ARE BASED ARRAYS), 
*         AND EVERY POINTER TO AN OBJECT WITHIN A TABLE IS AN INDEX 
*         RELATIVE TO THE BASE ADDRESS OF THE TABLE.  THE ORDER 
*         IN WHICH MANAGED TABLES ARE STORED IN MEMORY IS GENERALLY 
*         ALPHABETICALLY BY TABLE NAME, WITH TWO EXCEPTIONS.  (1) 
*         TSUB IS FIRST BECAUSE IT IS USUALLY THE LARGEST TABLE 
*         AND THEREFORE SHOULD NOT HAVE TO BE MOVED TO MAKE ROOM
*         FOR OTHER TABLES.  (2)  TVAR IMMEDIATELY FOLLOWS TXEQ 
*         BECAUSE OF THE WAY PASS2/CCT COMBINES THEM TOGETHER.
* 
*         THERE ARE TWO POINTER WORDS FOR EACH TABLE.  THE FIRST, 
*         TXXX OR P<TXXX>, IS THE BASED ARRAY POINTER AND CONTAINS
*         THE FWA OF THE TABLE IN MEMORY.  THE SECOND WORD, TXXXL,
*         CONTAINS THE LENGTH IN WORDS OF THE MEMORY SPACE THAT IS
*         CURRENTLY ALLOCATED TO THE TABLE. 
* 
*         DUE TO LANGUAGE RESTRICTIONS IN SYMPL, THE STORAGE  AREA
*         CONTAINING  THE MANAGED (DYNAMIC) TABLE POINTERS MUST BE
*         DECLARED IN TWO DIFFERENT WAYS.  IN THE  CODE  GENERATOR
*         MAIN PROGRAM *DDLCG* IT IS A SERIES OF XDEF BASED ARRAYS
*         AND  LENGTH  ITEMS,  WHILE  IN THE *MANAGER* PACKAGE THE
*         SAME AREA IS AN ARRAY OF 2-WORD ENTRIES.  THE  RESULTING
*         CORRESPONDENCE OF STORAGE LOCATIONS IS AS FOLLOWS.
* 
*               DDLCG                MANAGER              VIA 
*             XDEF NAME      XREF NAME    TABLES ITEM     DEF 
* 
*               NTAB           NTAB           -            -
*               TABLES         TABLES      TABF [0]       BASE
*               FL             FL          TABL [0]        -
*             P<TSUB>            -         TABF [1]        -
*               TSUBL            -         TABL [1]        -
*             P<TCAP>            -         TABF [2]        -
*               TCAPL            -         TABL [2]        -
*               ...              -           ...           -
*             P<TVAR>            -         TABF [N]        -
*               TVARL            -         TABL [N]        -
*             P<TEND>          TEND        TABF [N+1]      -
*               TENDL          TENDL       TABL [N+1]     SU
* 
*         ALL OTHER SUBPROGRAMS DECLARE ONLY THE TABLES THEY NEED,
*         AS XREF BASED ARRAYS AND LENGTH ITEMS.
# 
     XDEF BEGIN 
  
          ITEM NTAB ;              # NUMBER OF TABLES # 
          ITEM TABLES ;            # BASE = FWA OF TABLE AREA # 
          ITEM FL ;                # CURRENT CM FIELD LENGTH #
  
  
#*        TSUB  -  SUB-SCHEMA DIRECTORY AND FINISHED CAPSULES.
* 
*         ON ENTRY, THE COMPLETED SUB-SCHEMA DIRECTORY (WITHOUT 
*         CAPSULES) IS LEFT IN MEMORY BY THE SUB-SCHEMA COMPILER
*         THAT CREATED IT.  CELLS SBSCHMA AND SBSCHML CONTAIN THE 
*         FWA AND LENGTH OF THE DIRECTORY.  DDLCG SETS ITS POINTER
*         WORDS TSUB AND TSUBL EQUAL TO THEM (RESPECTIVELY), AND
*         THE SUB-SCHEMA DIRECTORY IS THEN TREATED LIKE ANY MANAGED 
*         TABLE THROUGHOUT CODE GENERATOR PROCESSING.  (DDLCG USES
*         ITS OWN POINTER WORDS, RATHER TNAN THE GLOBAL ONES, IN
*         ORDER TO INCREASE MANAGER EFFICIENCY BY HAVING ALL TABLE
*         POINTERS TOGETHER IN A VECTOR.)  AS EACH CAPSULE IS 
*         CREATED,  DDLCG INCREASES TSUBL (VIA MANAGER) AND APPENDS 
*         THE CAPSULE TO THE DIRECTORY.  AT THE END OF ALL CODE 
*         GENERATION, DDLCG COPIES ITS POINTER WORDS TSUB AND TSUBL 
*         INTO SBSCHMA AND SBSCHML (RESPECTIVELY) AND LEAVES THE
*         DIRECTORY + CAPSULES IN MEMORY FOR THE SUB-SCHEMA LIBRARY 
*         MAINTENANCE OVERLAY.  IF A MEMORY OVERFLOW OCCURS ANYTIME 
*         DURING CODE GENERATOR PROCESSING (SEE MANAGER/PTO), ALL 
*         OF THE CAPSULES ARE WRITTEN TO SCRATCH FILE *ZZZZZCS* AND 
*         TSUBL IS RESET TO INCLUDE JUST THE DIRECTORY PROPER.  THE 
*         LIBRARY MAINTENANCE OVERLAY CAN DETECT THIS CONDITION 
*         BECAUSE SBCWSBLENG (LENGTH OF DIRECTORY + CAPSULES) WILL
*         BE GREATER THAN SBSCHML (LENGTH OF DIRECTORY IN MEMORY).
# 
*CALL     COMDTSUB           SUB-SCHEMA DIRECTORY + FINISHED CAPSULES.
  
  
#*        TCAP  -  CURRENT CAPSULE (PASS 2).
* 
*         CONTAINS THE CAPSULE BEING FORMED, IN ITS ENTIRETY
*         EXCEPT FOR THE LOADER PREFIX TABLE.  EMPTY THROUGHOUT 
*         PASS 1.  BUILT IN PASS 2 FROM HEAD, TXEQ, TVAR, TCON, 
*         TEPT, TEXT, TREF, AND TREL, IN THAT ORDER.  WHEN IT IS
*         COMPLETED (AT THE END OF PASS 2), THE CONTENT OF TCAP 
*         IS EITHER APPENDED TO TSUB OR WRITTEN TO SCRATCH FILE 
*         *ZZZZZCS* DEPENDING ON WHETHER MEMORY OVERFLOW HAS
*         OCCURRED. 
# 
*CALL     COMDTCAP           CURRENT CAPSULE (PASS 2).
  
  
#*        TCON  -  CONSTANT VALUES. 
* 
*         BUILT BY PASS1/LDN AND USED BY PASS2/WCD.  BECOMES THE
*         *LITERALS BLOCK* PORTION OF THE CODE IMAGE IN TCAP. 
*         TCON ENTRIES ARE POINTED TO BY TLIT ENTRIES.
# 
*CALL     COMDTCON           CONSTANT VALUES. 
  
  
#*        TDBP  -  DATA BASE PROCEDURES.
* 
*         TRANSIENT TABLE CONTAINING THE NAME AND ORDINAL OF EACH 
*         DBP TO BE REFERENCED IN THE CALL TO DB$DPII CURRENTLY 
*         BEING GENERATED.   CREATED BY PASS1/BDL AND USED BY 
*         PASS1/GDL.  EMPTY THROUGHOUT PASS 2.
# 
*CALL     COMDTDBP           DATA BASE PROCEDURES.
  
  
#*        TDPL  -  DATABASE PROCEDURE LIST POINTERS.
* 
*         CREATED AND USED BY PASS1/GDL TO ELIMINATE DUPLICATE
*         DBP LISTS.  CONTAINS POINTERS TO ALL DBP LISTS THAT 
*         HAVE BEEN GENERATED THUS FAR IN THE CURRENT CAPSULE.
*         EMPTY THROUGHOUT PASS 2.
# 
*CALL     COMDTDPL           DATA BASE PROCEDURE LIST POINTERS. 
  
  
#*        TDPN  -  DATABASE PROCEDURE NAMES (FROM SCHEMA).
* 
*         CONTAINS ALL DBP NAMES KNOWN IN THE SCHEMA, IN THE
*         ORDER IN WHICH THEY ARE LISTED IN THE SCHEMA DIRECTORY. 
*         CREATED IN DDLCG INITIALISATION.  USED BY PASS1/BDL 
*         TO STORE DBP ORDINALS ALONG WITH THE NAMES IN TDBP. 
# 
*CALL     COMDTDPN           DATA BASE PROCEDURE NAMES (FROM SCHEMA). 
  
  
#*        TEMP  -  TEMPORARY VARIABLES. 
* 
*         CREATED AND USED BY PASS1/GTV TO KEEP TRACK OF ALL
*         TEMPORARY VARIABLES CURRENTLY IN USE, AND BY PASS1/ 
*         EXIT TO ALLOCATE STORAGE FOR TEMPORARY VARIABLES
*         (VNNNNNN).  EMPTY THROUGHOUT PASS 2.
# 
*CALL     COMDTEMP           TEMPORARY VARIABLES. 
  
  
#*        TEPT  -  ENTRY POINTS.
* 
*         BUILT IN PASS1 INITIALISATION FOR EACH CAPSULE AND USED 
*         BY PASS2/WEP.  BECOMES THE *ENTRY POINTS* PORTION OF
*         THE CAPSULE IN TCAP, FOLLOWING THE CONSTANTS. 
# 
*CALL     COMDTEPT           ENTRY POINTS.
  
  
#*        TEXI  -  EXTERNAL IDENTIFIERS.
* 
*         CREATED BY PASS2/CRC, ONLY IF OBJECT CODE LISTING IS
*         REQUESTED.  USED BY EDITOR/PSA.  CONTAINS THE EXTERNAL
*         NAMES FROM TEXT IN THEIR PASS 1 ORDER, BEFORE TEXT IS 
*         SORTED INTO ALPHABETIC ORDER IN PASS 2 AS REQUIRED BY 
*         THE CAPSULE LOADER.  NEEDED BECAUSE EXTERNAL REFERENCES 
*         IN INTERMEDIATE CODE ARE PASS 1 INDICES INTO TEXT.
*         EMPTY THROUGHOUT PASS 1.
# 
*CALL     COMDTEXI           EXTERNAL IDENTIFIERS.
  
  
#*        TEXT  -  EXTERNAL NAMES.
* 
*         IN PASS 1, TEXT CONTAINS NAMES OF EXTERNAL (TO THE CODE 
*         CAPSULE BEING COMPILED) SYMBOLS IN THE ORDER ENCOUNTERED, 
*         AND WITH EACH NAME A POINTER USED BY ISSUE/ISA TO APPEND
*         TREF ENTRIES.  IN PASS 2, TEXT IS SORTED INTO ALPHABETIC
*         ORDER, AND THE NAMES ARE FOLLOWED BY REFERENCE LISTS IN 
*         THE FORMAT REQUIRED BY THE CAPSULE LOADER.  BUILT BY
*         PASS1/EXN, REARRANGED BY PASS2/CRC, AND WRITTEN OUT BY
*         PASS2/WEX.  BECOMES THE *EXTERNAL NAMES AND REFERENCES* 
*         PORTION OF THE CAPSULE IN TCAP, FOLLOWING THE ENTRY 
*         POINTS. 
# 
*CALL     COMDTEXT           EXTERNAL NAMES.
  
  
#*        TITM  -  KEY ITEM JUMP INDICES. 
* 
*         CREATED AND USED ONLY BY MAPKEY IN PASS 1.  CREATED 
*         AFRESH FOR EACH RECORD TYPE PROCESSED.  CONTAINS ONE
*         ENTRY FOR EACH DATA ITEM IN THE RECORD.  THE ENTRY IS 
*         A POINTER TO THE CORRESPONDING TKEY ENTRY IF THE ITEM 
*         IS A KEY ITEM, ELSE ZERO.  EMPTY THROUGHOUT PASS 2. 
# 
*CALL     COMDTITM           KEY ITEM JUMP INDICES. 
  
  
#*        TKEY  -  KEY ITEM JUMP VECTOR.
* 
*         CREATED AND USED ONLY BY MAPKEY IN PASS 1.  CREATED 
*         AFRESH FOR EACH RECORD TYPE PROCESSED.  CONTAINS ONE
*         ENTRY FOR EACH KEY ITEM MAPPING ROUTINE IN THE CAPSULE
*         FOR THIS RECORD.  EMPTY THROUGHOUT PASS 2.
# 
*CALL     COMDTKEY           KEY ITEM JUMP VECTOR.
  
  
#*        TLIT  -  LITERALS.
* 
*         BUILT IN PASS 1 AND USED IN PASS 2.  IN THE INTERMEDIATE
*         CODE IN TXEQ AND TVAR, EACH LITERAL REFERENCE POINTS TO 
*         A TLIT ENTRY.  THE TLIT ENTRY CONTAINS  (1) A COMPASS 
*         LIKE SOURCE REPRESENTATION OF THE LITERAL, FOR USE IN 
*         OBJECT CODE LISTING, AND  (2) POINTERS TO THE LITERAL 
*         VALUE IN TCON.  MULTIPLE TLIT ENTRIES CAN POINT TO THE
*         SAME WORD(S) IN TCON. 
# 
*CALL     COMDTLIT           LITERALS.
  
  
#*        TPAG  -  LISTING PAGE FOR PRINTING TWO COLUMNS. 
* 
*         THIS TABLE IS ALLOCATED IN LISTER INITIALISATION, ONLY
*         WHEN OBJECT CODE LISTING IS REQUESTED.  IT IS BIG ENOUGH
*         TO HOLD 70-CHARACTER LOGICAL LINES TO FILL TWO COLUMNS OF 
*         A LISTING PAGE, I.E., TWICE THE NUMBER OF PHYSICAL LINES
*         PER PAGE.  EDITOR/PRINT COLLECTS THE LOGICAL LINES.  WHEN 
*         TPAG IS FULL, LISTER/DPAGE REARRANGES THE LOGICAL LINES 
*         TO MAKE TWO COLUMNS AND WRITES THE PHYSICAL LINES TO THE
*         LISTING OUTPUT FILE.
# 
*CALL     COMDTPAG           LISTING PAGE FOR PRINTING TWO COLUMNS. 
  
  
#*        TREC  -  RECORD TYPE JUMP VECTOR. 
* 
*         CREATED AND USED ONLY BY MAPKEY IN PASS 1.  CONTAINS
*         ONE ENTRY FOR EACH RECORD TYPE IN THE REALM BEING 
*         PROCESSED.  BECOMES THE JUMP VECTOR, INDEXED BY RECORD
*         ORDINAL, AT THE BEGINNING OF EACH KEY MAPPING CAPSULE.
*         EMPTY THROUGHOUT PASS 2.
# 
*CALL     COMDTREC           RECORD TYPE JUMP VECTOR. 
  
  
#*        TREF  -  REFERENCES TO EXTERNALS (PASS 1).
* 
*         CONTAINS ONE OR MORE WORDS (NOT NECESSARILY CONTIGUOUS) 
*         FOR EACH EXTERNAL (TO THE CAPSULE) SYMBOL, WITH UP TO 
*         TWO REFERENCE ENTRIES IN A WORD.  BUILT BY ISSUE/ISA. 
*         USED BY PASS2/CRC WHICH REFORMATS THE REFERENCES (AS
*         REQUIRED BY THE CAPSULE LOADER) AND APPENDS THEM TO TEXT. 
# 
*CALL     COMDTREF           REFERENCES TO EXTERNALS (PASS 1).
  
  
#*        TREL  -  RELOCATION BITS (PASS 2).
* 
*         BUILT BY PASS2/RSA AND PASS2/FUP, AND USED BY PASS2/WRB.
*         BECOMES THE *RELOCATION BITS* PORTION OF THE CAPSULE IN 
*         TCAP, FOLLOWING THE EXTERNAL NAMES AND REFERENCES.
*         CONTAINS FOUR BITS OF RELOCATION INDICATORS FOR EACH
*         WORD OF THE CODE IMAGE, AS REQUIRED BY THE CAPSULE
*         LOADER.  EMPTY THROUGHOUT PASS 1. 
# 
*CALL     COMDTREL           RELOCATION BITS (PASS 2).
  
  
#*        TSCH  -  SCHEMA DIRECTORY (CURRENT PORTION).
* 
*         CONTAINS THE CURRENT RECORD ENTRY WITH ITS ITEM ENTRIES 
*         FROM THE SCHEMA DIRECTORY.  CREATED BY DDLCG/FINDREC AND
*         USED BY MANY PASS 1 ROUTINES. 
# 
*CALL     COMDTSCH           SCHEMA DIRECTORY (CURRENT PORTION).
  
  
#*        TSYM  -  SYMBOL TABLE.
* 
*         CREATED BY PASS1/SYN AND USED BY MANY ROUTINES.  CONTAINS 
*         NAMES AND CODE IMAGE LOCATIONS OF STATEMENT LABELS, 
*         VARIABLES, ETC. IN THE OBJECT CODE.  IN THE INTERMEDIATE
*         CODE, A SYMBOL REFERENCE IS ALWAYS A POINTER TO ITS TSYM
*         ENTRY.  IN THE CODE GENERATOR LOGIC, A SYMBOL REFERENCE 
*         CAN BE EITHER THE TSYM INDEX OR THE SYMBOL NAME.  MOST
*         SYMBOLS ARE NOT ASSIGNED NAMES IN PASS 1.  FOR THESE, 
*         PASS2/CCT CONSTRUCTS A NAME OF THE FORM *LNNNNNN* WHERE 
*         NNNNNN IS THE OCTAL LOCATION IN THE CODE IMAGE. 
# 
*CALL     COMDTSYM           SYMBOL TABLE.
  
  
#*        TXEQ  -  EXECUTABLE CODE AND PSEUDO OPS (INTERMEDIATE). 
* 
*         CREATED BY ISSUE IN PASS 1 AND USED BY PASS2/WIN. 
*         CONTAINS A STREAM OF 15- OR 30-BIT MACHINE INSTRUCTIONS,
*         INTERMIXED WITH PSEUDO INSTRUCTIONS OF 15, 30, 45, OR 
*         60 BITS.  INSTRUCTIONS ARE PACKED AND CAN SPAN WORD 
*         BOUNDARIES ARBITRARILY.  MACHINE INSTRUCTIONS ARE IN
*         THEIR ACTUAL BINARY FORM, EXCEPT THAT ALL NON-ABSOLUTE
*         18-BIT ADDRESS FIELDS CONTAIN POINTERS INTO TEXT, TLIT, 
*         OR TSYM, TO BE RELOCATED BY PASS2/RSA.  ANY SUCH MACHINE
*         INSTRUCTION IS PRECEDED BY A PSEUDO INSTRUCTION THAT
*         SPECIFIES AN ADDRESS RELOCATION INDICATOR.  FOR DETAILS 
*         ON PSEUDO INSTRUCTIONS, SEE ISSUE/IPI, PASS2/WPI, EDITOR/ 
*         PPI, AND COMMON DECK COMDOPS.  TXEQ AND TVAR ARE COMBINED 
*         BY PASS2/CCT AND PROCESSED BY PASS2/WIN ET AL. TO BECOME
*         THE *INSTRUCTIONS AND DATA* PORTION OF THE CODE IMAGE 
*         IN TCAP.
# 
*CALL     COMDTXEQ           EXECUTABLE CODE + PSEUDO OPS (INTERMEDIATE)
  
  
#*        TVAR  -  VARIABLES AND APLISTS (INTERMEDIATE).
* 
*         SAME FORMAT AND USAGE AS TXEQ.  TVAR IS EFFECTIVELY 
*         (IN COMPASS TERMINOLOGY) A SECOND *USE* BLOCK.  THIS
*         ENABLES THE CODE GENERATOR TO GENERATE APLISTS AND
*         VARIABLES IN PARALLEL WITH EXECUTABLE CODE, WITHOUT 
*         HAVING TO GENERATE JUMPS AROUND THEM. 
# 
*CALL     COMDTVAR           VARIABLES AND APLISTS (INTERMEDIATE).
  
  
#*        TEND  -  DUMMY LAST TABLE.
* 
*         SERVES NO PURPOSE EXCEPT TO TERMINATE THE VECTOR OF 
*         TABLE POINTERS USED BY MANAGER. 
# 
*CALL     COMDTEND           DUMMY LAST TABLE.
  
          END 
  
  
     DEF  SU  #TENDL# ;            # STORAGE USED # 
  
  
     XDEF BEGIN               # NAMES OF EXTERNALS USED BY CAPSULES # 
  
          ITEM X$CMPR C (WC) = "DC$CMPR" ;   # COMPARE VALUE (PROC) # 
          ITEM X$CONV C (WC) = "DC$CONV" ;   # CONVERT VALUE (PROC) # 
          ITEM X$DPII C (WC) = "DB$DPII" ;   # DBP INTERFACE ITEM LEVEL#
          ITEM X$MBUF C (WC) = "DB$MBUF" ;   # KEY MAP SCRATCH BUF FWA #
          ITEM X$MDNA C (WC) = "DB$MDNA" ;   # DATA NAME ADDRESS (RES) #
          ITEM X$MERF C (WC) = "DB$MERF" ;   # MAPPING ERROR FLAG # 
          ITEM X$MERP C (WC) = "DB$MERP" ;   # ERROR DBP APLIST FWA # 
          ITEM X$MFIT C (WC) = "DB$MFIT" ;   # FILE INFO TABLE FWA #
          ITEM X$MIOR C (WC) = "DB$MIOR" ;   # ITEM ORDINAL (KEY/RES) # 
          ITEM X$MKEY C (WC) = "DB$MKEY" ;   # KEY MAP MODE (KEY/RES) # 
          ITEM X$MMOD C (WC) = "DB$MMOD" ;   # WRITE MAP MODE (MOD/STO)#
          ITEM X$MRBF C (WC) = "DB$MRBF" ;   # RESULT IN BUFFER FLAG #
          ITEM X$MROR C (WC) = "DB$MROR" ;   # RECORD ORDINAL (KEY/RES)#
          ITEM X$MSCH C (WC) = "DC$MSCH" ;   # SCHEMA RECORD AREA FWA # 
          ITEM X$MSCR C (WC) = "DC$MSCR" ;   # SCRATCH AREA (REC MAP) # 
          ITEM X$MSSO C (WC) = "DB$MSSO" ;   # SUB-SCHEMA ITEM ORDINAL #
          ITEM X$MSUB C (WC) = "DB$MSUB" ;   # SUB-SCHEMA REC AREA FWA #
          ITEM X$NLFL C (WC) = "DC$NLFL" ;   # NULL FILL ITEM (PROC) #
          ITEM X$SBBP C (WC) = "DC$SBBP" ;   # SOURCE BEGINNING BIT POS#
          ITEM X$SBWP C (WC) = "DC$SBWP" ;   # SOURCE BEGINNING WRD POS#
          ITEM X$SFWA C (WC) = "DC$SFWA" ;   # SOURCE FIRST WORD ADDR # 
          ITEM X$TBBP C (WC) = "DC$TBBP" ;   # TARGET BEGINNING BIT POS#
          ITEM X$TBWP C (WC) = "DC$TBWP" ;   # TARGET BEGINNING WRD POS#
          ITEM X$TFWA C (WC) = "DC$TFWA" ;   # TARGET FIRST WORD ADDR # 
          ITEM X$XFER C (WC) = "DC$XFER" ;   # TRANSFER DATA (PROC) # 
  
          END 
  
  
     XDEF BEGIN               # OTHER PUBLIC DATA # 
  
  
#*        LOOP  -  LOOP NESTING CONTROL TABLE.
* 
*         ANY *OCCURS* CLAUSE IN THE SCHEMA DIRECTORY CAUSES A
*         LOOP IN THE GENERATED EXECUTABLE CODE.  THE PASS 1
*         MODULE GLC CREATES AND USES THE LOOP TABLE TO KEEP
*         TRACK OF THESE LOOPS.  THERE IS ROOM FOR UP TO THREE
*         ENTRIES BECAUSE LOOPS CAN BE NESTED UP TO THREE DEEP. 
# 
*CALL     COMDLOOP           LOOP NESTING CONTROL TABLE.
  
  
#*        REGS  -  REGISTER ASSOCIATES. 
* 
*         THIS ARRAY IS CREATED AND USED BY THE PASS 1 MODULE REG 
*         TO KEEP TRACK OF WHAT VALUES AND KINDS OF VALUES WILL 
*         BE IN THE 24 OPERATING REGISTERS OF THE CPU AT OBJECT 
*         CODE EXECUTION TIME.
# 
          ARRAY REGS [0:7] P (4) ; # REGISTER ASSOCIATES #
               BEGIN
               ITEM REGA U (0, 0, WL) ;      # SEE COMMON DECK #
               ITEM REGB U (1, 0, WL) ;      # *COMDREG* FOR   #
               ITEM REGX U (2, 0, WL) ;      # FURTHER DETAILS #
               ITEM VALX U (3, 0, WL) ; 
               END
  
  
#*        SCHDIT  -  SCHEMA DIRECTORY INFORMATION TABLE.
* 
*         CREATED AND USED BY THE SCHEMA DIRECTORY ACCESS 
*         ROUTINES CALLED BY DDLCG INITIALISATION AND FINDREC 
*         ROUTINES. 
# 
*CALL     COMDSCH            SCHEMA DIRECTORY INFORMATION TABLE.
  
  
#*        INDIVIDUAL PUBLIC VARIABLES.
# 
          ITEM CAPA I = 0 ;        # CAPSULE WORD ADDRESS # 
          ITEM CAPL I = 0 ;        # CAPSULE LENGTH IN WORDS #
          ITEM CAPS B = FALSE ;    # TRUE IF CAPSULES ON SCRATCH FILE # 
          ITEM CFRN I = 0 ;        # CURRENT FETCH REG. NO. (1-5) # 
          ITEM CSRN I = 0 ;        # CURRENT STORE REG. NO. (6-7) # 
          ITEM CSRA I = 0 ;        # CURRENT STORE REGISTER ADDRESS # 
          ITEM CSRI I = 0 ;        # CURRENT STORE REGISTER ITEM PTR #
          ITEM DBPA = 0 ;          # TSYM INDEX OF DBP APLIST LABEL # 
          ITEM DBPI = 0 ;          # TSYM INDEX OF DBP NAME LIST LABEL #
          ITEM DCTN C (WC) = " " ; # DISPLAY TO COLLATING TABLE NAME #
          ITEM END0 ;              # LWA+1 OF DDLCG (6,0) OVERLAY # 
          ITEM END1 ;              # LWA+1 OF DDLCGP1 (6,1) OVERLAY # 
          ITEM END2 ;              # LWA+1 OF DDLCGP2 (6,2) OVERLAY # 
          ITEM FITP I = 0 ;        # FILE INFORMATION TABLE POINTER # 
          ITEM FWAF B = FALSE ;    # TRUE IF DC$SFWA AND DC$TFWA SET #
          ITEM GETF B = FALSE ;    # TRUE WHEN GENERATING READ MAPPING #
          ITEM GROUP I = 0 ;       # BIT MASK FOR GROUP DATA-TYPES #
          ITEM ILEN I = 0 ;        # INSTRUCTION LENGTH: PARCELS - 1 #
          ITEM ILOC I = 3 ;        # LOCATION COUNTER FOR TXEQ #
          ITEM INST U = 0 ;        # INSTR, LEFT JUST, FOR TXEQ/TVAR #
          ITEM INSW U = 0 ;        # INSTRUCTION WORD GOING TO TCAP # 
          ITEM INTW U = 0 ;        # INSTRUCTION WORD GOING TO TXEQ # 
          ITEM IPAR I = 0 ;        # PARCEL NUMBER OF INSTR. (0-3) #
          ITEM IPOS I = 0 ;        # BEGINNING BIT POSITION OF INSTR. # 
          ITEM LINECT I = 0 ;      # COUNT OF LOGICAL LINES IN *TPAG* # 
          ITEM LOOPL I = 0 ;       # LOOP NESTING LEVEL # 
          ITEM MAPX S:MAP = 0 ;    # PASS 1 MODE INDICATOR #
          ITEM NAME C (30) = " " ; # CURRENT RECORD OR ITEM NAME #
          ITEM NAMEL I = 0 ;       # NAME LENGTH IN WORDS # 
          ITEM NEXT I = 0 ;        # NEXT SCHEMA/SUB-SCH ITEM POINTER # 
          ITEM NREC I = 0 ;        # NUMBER OF RECORDS IN REALM # 
          ITEM NSIF B = FALSE ;    # NO SOURCE ITEM FLAG #
          ITEM QBUF C (WC) = " " ; # NAME OF SCRATCH BUFFER AREA FWA #
          ITEM QSRA C (WC) = " " ; # NAME OF SOURCE RECORD AREA FWA # 
          ITEM QTRA C (WC) = " " ; # NAME OF TARGET RECORD AREA FWA # 
          ITEM REALMH  C (30) ;    # REALM NAME IN 30H FORMAT # 
          ITEM RECORDH C (30) ;    # RECORD TYPE NAME IN 30H FORMAT # 
          ITEM RECI I = 0 ;        # RECORD LIST INDEX #
          ITEM RIBF B = FALSE ;    # RESULT IN BUFFER FLAG #
          ITEM RLMI I = 0 ;        # REALM LIST INDEX # 
          ITEM SBBP I = WL ;       # SOURCE BEGINNING BIT POSITION #
          ITEM SBWP I = -1 ;       # SOURCE BEGINNING WORD POSITION # 
          ITEM SCIO = 0 ;          # SCHEMA ITEM ORDINAL #
          ITEM SCIP = 0 ;          # SCHEMA ITEM ENTRY POINTER #
          ITEM SCNI = 0 ;          # NO. OF ITEMS IN SCHEMA RECORD #
          ITEM SCRA = 0 ;          # SCHEMA RECORD ENTRY WORD ADDRESS # 
          ITEM SI = 0 ;            # SOURCE ITEM INDEX #
          ITEM SSAP = 0 ;          # SUB-SCHEMA REALM ENTRY POINTER # 
          ITEM SSIO = 0 ;          # SUB-SCHEMA ITEM ORDINAL #
          ITEM SSIP = 0 ;          # SUB-SCHEMA ITEM ENTRY POINTER #
          ITEM SSNI = 0 ;          # NO. OF ITEMS IN SUB-SCHEMA RECORD #
          ITEM SSRP = 0 ;          # SUB-SCHEMA RECORD ENTRY POINTER #
          ITEM SSRQ = 0 ;          # SUB-SCHEMA RECORD ENTRY LWA+1 #
          ITEM SUBL I = 0 ;        # SUB-SCHEMA LENGTH WITHOUT CAPSULES#
          ITEM SW = 0 ;            # SOURCE WORD INDEX #
          ITEM TBBP = 0 ;          # TARGET BEGINNING BIT POSITION #
          ITEM TBWP = 0 ;          # TARGET BEGINNING WORD POSITION # 
          ITEM TI = 0 ;            # TARGET ITEM INDEX #
          ITEM TLEV = 0 ;          # TARGET ITEM LEVEL-NUMBER # 
          ITEM TW = 0 ;            # TARGET WORD INDEX #
          ITEM VARF B = FALSE ;    # TRUE IF IN A VARIABLE DIMENSION #
          ITEM VBLW U = 0 ;        # INSTRUCTION WORD GOING TO TVAR # 
          ITEM VECTOR = 0 ;        # BIT MASK FOR VECTOR DATA-TYPES # 
          ITEM VLOC I = 0 ;        # LOCATION COUNTER FOR TVAR #
          ITEM VPAR I = 0 ;        # PARCEL NUMBER (0-3) FOR TVAR # 
          ITEM VPOS I = 0 ;        # NEXT BIT POSITION IN VBLW #
          ITEM XPOS I = 0 ;        # NEXT BIT POSITION IN INTW #
  
          END 
  
  
     XREF BEGIN               # EXTERNAL REFERENCES # 
  
*CALL     COMDHEAD           CAPSULE HEADER TABLE.
*CALL     COMDPRFX           CAPSULE PREFIX TABLE.
          ITEM CSCR U ;            # CAPSULE SCRATCH FILE # 
          ITEM DDLMEM U ;          # FIELD LENGTH, STORAGE USED # 
          ITEM DDLSU ;             # STORAGE USED # 
          ITEM OLD65 ;             # LWA+1 OF LAST OVERLAY LOADED # 
          ITEM SBSCHMA I ;         # FWA OF SUB-SCHEMA IN MEMORY #
          ITEM SBSCHML ;           # LENGTH OF SUB-SCHEMA IN MEMORY # 
          ITEM SCLFN I ;           # SCHEMA DIRECTORY FILE NAME # 
          PROC ALLOC ;             # ALLOCATE TABLE SPACE # 
          PROC DE$CLSC;            # CLOSE SCHEMA DIRECTORY FILE #
          PROC DE$NMSC ;           # SCHEMA DIRECTORY ACCESS BY NAME #
          PROC DE$OPSC ;           # OPEN SCHEMA DIRECTORY FILE # 
          PROC FEED ;              # PRINT N BLANK LINES #
          PROC ISSUE ;             # ISSUE INSTRUCTION TO INTERMEDIATE #
          PROC LISTER ;            # INITIALISE FOR LISTING OUTPUT #
          PROC LOADOVL ;           # LOAD AND INITIATE OVERLAY #
          PROC MANAGER ;           # INITIALISE TABLE MANAGEMENT #
          PROC PRFXA ;             # INITIALISE CAPSULE PREFIX TABLE #
          PROC READSC ;            # READ SCHEMA DIRECTORY #
          PROC SDA ;               # SET DYNAMIC AREA BASE ADDRESS #
          PROC SSLLD ;             # DO SUB-SCHEMA LIBRARY MAINTENANCE #
          PROC WRITER ;            # WRITE END OF RECORD #
          FUNC FOLGDE ;            # GET LWA FROM FOL DIRECTORY ENTRY  #
          FUNC XCDD C (WC) ;       # CONVERT TO DECIMAL DISPLAY CODE #
          FUNC XSFW C (WC) ;       # SPACE FILL WORD #
  
          END 
  
  
*CALL     COMDCF             CONSTANT FORMATS.
  
  
*CALL     COMDDBPE           DATA BASE PROCEDURE ENTRY CODES. 
  
  
*CALL     COMDITEM           ITEM CLASS AND TYPE CODES. 
  
  
*CALL     COMDOPS            OPERATION CODES. 
  
  
*CALL     COMDPSOP           PSEUDO OPERATION ISSUING DEFS. 
  
  
#         LOCAL DATA. 
# 
          ARRAY [0:3] ;            # DISPLAY CODE TO COLLATING SEQUENCE#
               BEGIN                         # CONVERSION TABLE NAMES # 
               ITEM DCTNAME C (0, 0, WC) =
                       [ "DB$MDCX",          # DISPLAY TO DISPLAY # 
                         "DB$MDCA",          # DISPLAY CODE TO ASCII #
                         "DB$MDCC",          # DISPLAY CODE TO COBOL #
                         "DB$MDCU" ] ;       # DISPLAY CODE TO USER  #
               END
          BASED ARRAY CM ;         # CENTRAL MEMORY  -  USE FOR # 
               BEGIN                   # ABSOLUTE ADDRESSING BY # 
               ITEM RA  U (0, 0, WL) ;  # SETTING P<CM> = 0 # 
               ITEM HHA I (O"104", 42, 18) ;
               END
          BASED ARRAY REALMLIST [1:9] S (4) ;  # SUB-SCHEMA REALM LIST #
               BEGIN
*CALL     SBRLMLST           SUB-SCHEMA REALM LIST DECLARATIONS.
               END
          BASED ARRAY RECORDLIST [1:9] ;     # SUB-SCHEMA RECORD LIST # 
               BEGIN
*CALL     SBRECLST           SUB-SCHEMA RECORD LIST DECLARATIONS. 
               END
          DEF  SCHBUFL  #195# ;    DEF  SCHL  #192# ; 
          ARRAY SCHBUF (SCHBUFL) ; ;    # CIO BUFFER FOR READING SCHEMA#
          BASED ARRAY TDUM ; ;     # DUMMY BASED ARRAY #
  
  
  
  
#***      DDLCG - DDL CODE GENERATOR MAIN PROGRAM.
  
          PRGM DDLCG
  
*         INITIALISE. 
*              TABLE MANAGEMENT.
*              LISTING OUTPUT.
*              CAPSULE PREFIX TABLE.
*         GET DBP NAMES FROM SCHEMA INTO TDPN.
*         GET REALM LIST FROM SUB-SCHEMA. 
*         FOR EACH REALM... 
*              GET REALM INFO FROM SCHEMA AND SUB-SCHEMA. 
*              GET RECORD LIST FOR THIS REALM FROM SUB-SCHEMA.
*              FOR EACH RECORD... 
*                   (FINDREC) GET RECORD INFO FROM SCHEMA 
*                        AND SUB-SCHEMA.
*                   COMPILE WRITE/REWRITE RECORD MAPPING CAPSULE. 
*                   COMPILE READ RECORD MAPPING CODE CAPSULE. 
*              COMPILE KEY MAPPING CODE CAPSULE FOR THE REALM.
*         COMPLETE OUTPUT FILES.
*         PROCEED TO SUB-SCHEMA LIBRARY MAINTENANCE OVERLAY.
****
# 
          BEGIN 
  
          ITEM A C (WC) ;          # CHARACTER TEMPORARY #
          ITEM I ;                 # INTEGER TEMPORARY #
  
#         INITIALISE. 
# 
          P<CM> = 0 ; 
          END0 = OLD65 ;           # SET DYNAMIC AREA BASE #
          END1 = HHA ;              # ADDRESS FOR EACH OVERLAY #
          END2 = HHA ;
          GROUP  = 2 ** (WL - 1 - TYPE"SIMPLGRP") 
                    + 2 ** (WL - 1 - TYPE"REPGROUP")
                    + 2 ** (WL - 1 - TYPE"RGRPINRGRP")
                    + 2 ** (WL - 1 - TYPE"VARGRP")    ; 
          VECTOR = 2 ** (WL - 1 - TYPE"VECTOR") 
                    + 2 ** (WL - 1 - TYPE"VECTORREP") 
                    + 2 ** (WL - 1 - TYPE"VARVECTOR") ; 
          P<TSUB> = SBSCHMA ;      # SET SUB-SCHEMA POINTERS #
          TSUBL   = SBSCHML ; 
          SUBL = SBCWSBLENG ; 
          IF  SBCWNOMAP            # SKIP IF NO-MAP SUB-SCHEMA #
          THEN GO TO EXIT ; 
          CALL MANAGER ;           # INITIALISE TABLE MANAGEMENT #
          CALL LISTER ;            # INITIALISE FOR LISTING OUTPUT #
          CALL PRFXA ;             # INITIALISE CAPSULE PREFIX TABLE #
          C< 0,10> PRFXSCHEMA = XSFW (C< 0,10> SBCWSCHNAM30 [0]) ;
          C<10,10> PRFXSCHEMA = XSFW (C<10,10> SBCWSCHNAM30 [0]) ;
          C<20,10> PRFXSCHEMA = XSFW (C<20,10> SBCWSCHNAM30 [0]) ;
          I = SBCWSBHDRPTR ;
          PRFXSUBSCH = C<0,SBSCNAMELENC [I]> SBSCHNAM30 [I] ; 
          I = SCLFN ;                        # OPEN SCHEMA FILE # 
          IF  I EQ 0
          THEN B<0,NL> I = B<0,NL> SBCWSCHEMANM ; 
          CALL DE$OPSC (I, SCHDIT, SCHBUF, SCHBUFL) ; 
          ALLOC (P<TDPN>, SCCWDBPLENG) ;
          IF  TDPNL NE 0                     # READ DBP NAMES # 
          THEN READSC (TDPN, TDPNL, SCCWDBPWRDAR) ; 
  
#         PROCESS EACH REALM. 
# 
          FOR  RLMI = 1 THRU SBCWNUMAREAS  DO 
               BEGIN                         # GET REALM LIST ENTRY # 
               P<REALMLIST> = P<TSUB> + SBCWRLMLSTAD ;
               NREC = REALMRECLEN [RLMI] ;
               SSAP = REALMADR [RLMI] ; 
               IF  SBARNOMAPIND [SSAP]       # SKIP IF NO-MAP REALM # 
               THEN TEST RLMI ; 
               I = SBARDCONTRLA [SSAP] ;
               DCTN = DCTNAME [SBDCSEQOPT [I]] ;
               FITP = I + SBDCFITPTR [I] ;
               RIBF = FALSE ; 
               I = SSAP + SBARNAMEPTR [SSAP] ;
               HEADGROUP = C<0,NC> SBARNAME [I] ; 
               REALMH = C<0,SBARLENGCHAR [SSAP]> SBARNAME30 [I] ; 
  
#         PROCESS EACH RECORD TYPE. 
# 
               FOR  RECI = 1 THRU NREC  DO   # GET RECORD LIST ENTRY #
                    BEGIN                    # GET SCHEMA AND SUB- #
                    CALL FINDREC ;            # SCHEMA RECORD ENTRIES # 
                    IF SBRECNOMAP [SSRP]
                    THEN TEST RECI ;         # SKIP IF NO-MAP RECORD #
                    I = SSRP + SBRECNAMEPTR [SSRP] ;
                    PRFXCAP = C<0,NC> SBRECNAME [I] ; 
                    RECORDH = C<0,SBRECNMELENC [SSRP]> SBRECNAME30 [I] ;
                    A = XCDD (SBRECORDINAL [SSRP]) ;
                    PRFXRECO = C<5,5> A ; 
  
#         COMPILE RECORD MAPPING CODE CAPSULES FOR THE RECORD TYPE. 
# 
                    CALL MAPWR ;             # WRITE/REWRITE MAPPING #
                    CALL MAPRD ;             # READ RECORD MAPPING #
                    END 
  
#         COMPILE KEY MAPPING CODE CAPSULE FOR THE REALM. 
# 
               CALL MAPKEY ;                 # KEY MAPPING CODE CAPSULE#
               END
  
#         WRAP UP.
# 
          IF  SBCWMAXCAPL NE 0               # SET WORD ADDRESS OF #
          THEN SBCWFRSTCAPA = SUBL ;          # FIRST CAPSULE IF ANY #
          CALL SDA ( (FOLGDE) ) ;            # MOVE SUBSCHEMA FROM     #
                                             # UNDER 7,0 OVERLAY       #
          SBSCHMA = P<TSUB> ;                # UPDATE SUB-SCHEMA #
          SBSCHML = TSUBL ;                   # DIRECTORY POINTERS #
          I = ((SU + 63) / 64) * 64 ; 
          IF  I GT DDLSU                     # UPDATE STORAGE USED #
          THEN DDLSU = I ;
          IF  CAPS                           # IF CAPSULES SPILLED #
          THEN WRITER (CSCR) ;                # FLUSH SCRATCH FILE #
          CALL FEED (4, 6) ;                 # PRINT BLANK LINES #
          CALL DE$CLSC; 
 EXIT:    CALL SSLLD ;                       # PROCEED TO LIB. MAINT. # 
  
  
  
  
#***      FINDREC - GET SCHEMA AND SUB-SCHEMA RECORD ENTRIES. 
# 
          XDEF PROC FINDREC ; 
          PROC FINDREC ;
  
#         *FINDREC* LOCATES THE INDICATED ENTRY IN THE SUB-SCHEMA 
*         RECORD LIST, AND FROM THIS LOCATES THE SUB-SCHEMA RECORD
*         ENTRY AND THE CORRESPONDING SCHEMA RECORD ENTRY, AND
*         READS THE LATTER INTO *TSCH* ALONG WITH ITS ITEM ENTRIES. 
* 
*         ENTRY  (RLMI) = REALM INDEX.
*                (RECI) = RECORD INDEX .
* 
*         EXIT   (SCNI) = NUMBER OF ITEMS IN SCHEMA RECORD. 
*                (SCRA) = SCHEMA RECORD ENTRY WORD ADDRESS. 
*                (SSNI) = NUMBER OF ITEMS IN SUB-SCHEMA RECORD. 
*                (SSRP) = SUB-SCHEMA RECORD POINTER (REL TO *TSUB* FWA).
*                (SSRQ) = SUB-SCHEMA RECORD  LWA+1  (REL TO *TSUB* FWA).
****
# 
          BEGIN 
  
          ITEM W ;
  
#         GET SUB-SCHEMA RECORD LIST ENTRY. 
# 
          P<REALMLIST> = P<TSUB> + SBCWRLMLSTAD ; 
          P<RECORDLIST> = P<REALMLIST> + REALMRECLIST [RLMI] ;
          SSRP = RECLISTLADR [RECI] ;        # RECORD ENTRY STARTING #
          SSRQ = SSRP + RECLISTLLENG [RECI] ; # AND ENDING ADDRESSES #
          SSNI = SBRECNBRITMS [SSRP] ;       # NUMBER OF ITEMS #
  
#         GET CORRESPONDING SCHEMA RECORD ENTRY AND ITS ITEM ENTRIES. 
# 
          ALLOC (P<TSCH>, SCHL - TSCHL) ;    # ALLOCATE NOMINAL SPACE # 
          IF  SBRECALIASP [SSRP] NE 0 
          THEN BEGIN
               NAME = SBRECALIAS30 [SSRP + SBRECALIASP [SSRP]] ;
               NAMEL = SBRECALIASLW [SSRP] ;
               END                           # GET SCHEMA RECORD NAME # 
          ELSE BEGIN
               NAME = SBRECNAME30 [SSRP + SBRECNAMEPTR [SSRP]] ;
               NAMEL = SBRECNMELENW [SSRP] ;
               END                           # READ SCHEMA RECORD ENTRY#
          CALL DE$NMSC (SCHDIT, 1, NAME, NAMEL, TSCHL, TSCH) ;
          SCRA = DAENTAD ;                   # SET ITS WORD ADDRESS # 
          W = SCRECENTLEN - SCHL ;
          ALLOC (P<TSCH>, W) ;               # ADJUST SPACE ALLOCATED # 
          IF  W GT 0
          THEN BEGIN                         # IF MORE TO READ #
               P<TDUM> = P<TSCH> + SCHL ; 
               READSC (TDUM, W, SCRA+SCHL) ; # READ REMAINDER OF ENTRY #
               END
          SCNI = SCRNUMITEMS ;               # NUMBER OF ITEMS #
          RETURN ;
  
          END 
  
  
  
  
#***      MAPKEY - COMPILE KEY ITEM MAPPING CODE CAPSULE. 
# 
          PROC MAPKEY ; 
  
#***
# 
          BEGIN 
  
          PRFXCAP = HEADGROUP ;              # SETUP CAPSULE NAME # 
          IF  NREC GT 1 
          THEN BEGIN                         # IF MULTIPLE REC. TYPES # 
               PRFXRECO = " " ; 
               RECORDH  = " " ;              # CLEAR RECORD NAME #
               END
          CALL PASS1 (MAP"KEY") ;            # DO FIRST PASS #
          IF  TXEQL EQ 0
          THEN RETURN ; 
          CALL PASS2 ;                       # DO SECOND PASS # 
          SBARKEYCAPA [SSAP] = CAPA ;        # SET CAPSULE POINTERS IN #
          SBARKEYCAPL [SSAP] = CAPL ;         # SUB-SCHEMA REALM ENTRY #
          RETURN ;
  
          END 
  
  
  
  
#***      MAPRD - COMPILE READ RECORD MAPPING CODE CAPSULE. 
# 
          PROC MAPRD ;
  
#***
# 
          BEGIN 
  
          CALL PASS1 (MAP"READ") ;           # DO FIRST PASS #
          CALL PASS2 ;                       # DO SECOND PASS # 
          SBRECRDCAPA [SSRP] = CAPA ;        # SET CAPSULE POINTERS IN #
          SBRECRDCAPL [SSRP] = CAPL ;        # SUB-SCHEMA RECORD ENTRY #
          RETURN ;
  
          END 
  
  
  
  
#***      MAPWR - COMPILE WRITE/REWRITE RECORD MAPPING CODE CAPSULE.
# 
          PROC MAPWR ;
  
#***
# 
          BEGIN 
  
          CALL PASS1 (MAP"WRITE") ;          # DO FIRST PASS #
          CALL PASS2 ;                       # DO SECOND PASS # 
          SBRECWRCAPA [SSRP] = CAPA ;        # SET CAPSULE POINTERS IN #
          SBRECWRCAPL [SSRP] = CAPL ;        # SUB-SCHEMA RECORD ENTRY #
          RETURN ;
  
          END 
  
  
  
  
#***      PASS1 - DO FIRST PASS OF GENERATION OF ONE CODE CAPSULE.
# 
          PROC PASS1 (MODE) ; 
  
          ITEM MODE S:MAP ;        # CAPSULE TYPE INDICATOR # 
  
#***
# 
          BEGIN 
  
          MAPX = MODE ;                      # PASS MODE TO OVERLAY # 
          CALL SDA (END1) ;                  # SET DYNAMIC AREA # 
          CALL LOADOVL (END0, 6, 1) ;        # LOAD + EXECUTE OVERLAY # 
          RETURN ;
  
          END 
  
  
  
  
#***      PASS2 - DO SECOND PASS OF GENERATION OF ONE CODE CAPSULE. 
# 
          PROC PASS2 ;
  
#***
# 
          BEGIN 
  
          CALL SDA (END2) ;                  # SET DYNAMIC AREA # 
          CALL LOADOVL (END0, 6, 2) ;        # LOAD + EXECUTE OVERLAY # 
          RETURN ;
  
          END 
  
     END  TERM
