*COMDECK     COMGLC     - GENERATE LOOP CODE. 
#*        GLC  -  GENERATE LOOP CODE. 
* 
*         R. H. GOODELL.     77/04/27.
* 
*         *GLC* CONTAINS SUBROUTINES USED IN THE FIRST PASS OF THE
*         DDL CODE GENERATOR, TO PRODUCE CODE AT THE BEGINNING AND
*         END OF A LOOP FOR PROCESSING A REPEATING GROUP OR VECTOR
*         ITEM IN THE DATA.  THESE ROUTINES CREATE AND USE *LOOP* 
*         TABLE ENTRIES.  THEY ARE CALLED BY THE DRIVER ROUTINES
*         MAPRD AND MAPWR.
* 
*         CONTENTS (XDEF ENTRY POINTS). 
* 
*         PROC   GLC         GENERATE LOOP CODE (END OF LOOP).
*         PROC   SLC         SET LOOP CONTROLS (BEGINNING OF LOOP). 
# 
  
  
*CALL     COMDDEF            GENERAL DEFINITIONS. 
  
     XREF BEGIN               # MANAGED TABLES #
  
*CALL     COMDTEMP           TEMPORARY VARIABLES. 
  
*CALL     COMDTSCH           SCHEMA DIRECTORY (CURRENT PORTION).
  
*CALL     COMDTSUB           SUB-SCHEMA DIRECTORY + FINISHED CAPSULES.
  
*CALL     COMDTSYM           SYMBOL TABLE.
  
          END 
*CALL     COMDREG            REGISTER INFORMATION.
  
     XREF BEGIN               # OTHER EXTERNALS # 
  
*CALL     COMDLOOP           LOOP NESTING CONTROL TABLE.
          ITEM GETF B ;            # TRUE WHEN GENERATING READ MAPPING #
          ITEM LOOPL ;             # LOOP NESTING LEVEL # 
          ITEM NEXT I ;            # NEXT SCHEMA/SUB-SCH ITEM POINTER # 
          ITEM NSIF B ;            # NO SOURCE ITEM FLAG #
          ITEM SBBP I ;            # SOURCE BEGINNING BIT POSITION #
          ITEM SBWP I ;            # SOURCE BEGINNING WORD POSITION # 
          ITEM SCIP I ;            # SCHEMA ITEM ENTRY POINTER #
          ITEM SI ;                # SOURCE ITEM INDEX #
          ITEM SSIO I ;            # SUB-SCHEMA ITEM ORDINAL #
          ITEM SSIP I ;            # SUB-SCHEMA ITEM ENTRY POINTER #
          ITEM SSRP I ;            # SUB-SCHEMA RECORD ENTRY POINTER #
          ITEM SW ;                # SOURCE WORD INDEX #
          ITEM TBBP I ;            # TARGET BEGINNING BIT POSITION #
          ITEM TBWP I ;            # TARGET BEGINNING WORD POSITION # 
          ITEM TI ;                # TARGET ITEM INDEX #
          ITEM TLEV U ;            # TARGET ITEM LEVEL-NUMBER # 
          ITEM TW ;                # TARGET WORD INDEX #
          ITEM VARF B ;            # TRUE IF IN A VARIABLE DIMENSION #
          PROC CRA ;               # CLEAR REGISTER ASSOCIATES #
          PROC DSR ;               # DEPOSIT STORE REGISTER # 
          PROC FXR ;               # FIND X-REGISTER WITH SPECIFIED VAL#
          PROC GIC ;               # GENERATE ITEM CONVERSION CODE #
          FUNC GTV I ;             # GET TEMPORARY VARIABLE # 
          PROC GXR ;               # GET X-REGISTER WITH SPECIFIED VAL #
          PROC ISSUE ;             # ISSUE INSTRUCTION TO INTERMEDIATE #
          PROC SAR ;               # SET SPECIFIED A-REGISTER TO VALUE #
          PROC SB1 ;               # SET (B1) = 1 IF NECESSARY #
          PROC SXR ;               # SET SPECIFIED X-REGISTER TO VALUE #
  
          END 
  
  
*CALL     COMDCF             CONSTANT FORMATS.
  
  
*CALL     COMDITEM           ITEM CLASS AND TYPE CODES. 
  
  
*CALL     COMDOPS            OPERATION CODES. 
  
  
*CALL     COMDPSOP           PSEUDO OPERATION ISSUING DEFS. 
  
  
#         LOCAL DATA. 
# 
  
  
  
  
#***      GLC  -  GENERATE LOOP CODE. 
  
          PROC GLC
  
*         *GLC* IS CALLED AT THE END OF A LOOP FOR A REPEATING
*         (GROUP OR ELEMENTARY) ITEM, TO GENERATE THE CODE TO 
*         INCREMENT AND TEST THE SUBSCRIPT VARIABLE.
****
# 
          BEGIN 
  
          ITEM IV ;                # INDEX VARIABLE TSYM INDEX #
          ITEM IX ;                # ITS X-REGISTER NUMBER #
          ITEM SV, TV ;            # OFFSET VARIABLE TSYM INDEXES # 
          ITEM SX, TX ;            # THEIR X-REGISTER NUMBERS # 
          ITEM SS, TS ;            # GROUP SIZE X-REGISTER NUMBERS #
          ITEM VV ;                # TSYM INDEX FOR OTHER VARIABLES # 
  
#         GENERATE CODE AT END OF LOOP. 
# 
          NSIF == NSGF [LOOPL] ;
          IF  NOT NSIF
          THEN BEGIN
               LOCKX [4] = TRUE ; 
               SV = TEMV [SOFV [LOOPL]] ; 
               CALL GXR (SX, RK"VAL", SV, 0) ;   # GEN SA3 SOFFSETV    #
               LOCKX [SX] = TRUE ;               #  LOCK REGISTERS     #
               LOCKX [3] = TRUE ; 
               END
          LOCKX [4]  = FALSE ;
          TV = TEMV [TOFV [LOOPL]] ;
          CALL GXR (TX, RK"VAL", TV, 0) ;           # GEN SA4 TOFFSETV #
          LOCKX [TX] = TRUE ; 
          IF  NOT NSIF
          THEN BEGIN
               CALL GXR (SS, RK"CON", SSIZ [LOOPL], CF"INT") ;#SX1 SSIZ#
               LOCKX [3] = TRUE ; 
               END
          CALL GXR (TS, RK"CON", TSIZ [LOOPL], CF"INT") ;  # SX2 TSIZE #
          IF  NOT NSIF
          THEN BEGIN
               ISSUE (OP"IADD", 3, SX, SS) ;     # GEN IX3 X3 + X1     #
               LOCKX [SX] = FALSE ; 
               END
          ISSUE (OP"IADD", 4, TX, TS) ;                # GEN IX4 X4+X2 #
          LOCKX [TX] = FALSE ;
          REGX  [3] = 0 ; 
          LOCKX [3] = TRUE ;
          REGX  [4] = 0 ; 
          LOCKX [4] = TRUE ;
          IV = TEMV [INDV [LOOPL]] ;
          CALL SB1 ;                              # SET (B1) = 1       #
          CALL DSR ;                              # DEPOSIT STORE REG. #
          IF  LIMF [LOOPL]
          THEN BEGIN                              # IF VARIABLE LIMIT # 
               IX = 1 ;                            # FORCE IX = 1 # 
               CALL SXR (1, RK"VAL", IV, 0) ;       # GEN SA1 INDEXVAR #
               CALL SXR (2, RK"VAL", TEMV [LIMV [LOOPL]], 0) ;
               END                                  # GEN SA2 LIMITVAR #
                                                  # IF FIXED LIMIT #
          ELSE CALL GXR (IX, RK"VAL", IV, 0) ;      # GEN SA1 INDEXVAR #
          IF  NOT LIMF [LOOPL]                    # IF CONSTANT LIMIT # 
          THEN ISSUE (OP"SXXB", 6, IX, 1) ;         # GEN SX6 X1+B1    #
          ISSUE (XLABEL, ENDL [LOOPL]) ;          # GEN END-LOOP LABEL #
          CALL CRA ;                              # CLEAR REG. ASSOC. # 
          ITEMB [1] = 1 ;                          # EXCEPT (B1) = 1 #
          IF  GETF                                # IF READING AND #
            AND  LIMF [LOOPL]                      # VAR. DIMENSION # 
          THEN BEGIN
               ISSUE (OP"COPY", 6, 3, 3) ;          # GEN BX6 X3       #
               ISSUE (OP"LEFTB", 7, 0, 4) ;         # GEN LX7 X4       #
               CALL SAR (6, RK"SYM", SV, 0) ;       # GEN SA6 SOFFSETV #
               CALL SAR (7, RK"SYM", TV, 0) ;       # GEN SA7 TOFFSETV #
               END
          IF  LIMF [LOOPL]
          THEN BEGIN                              # IF VARIABLE LIMIT # 
               ISSUE (OP"SXXB", 6, 1, 1) ;          # GEN SX6 X1+B1    #
               ISSUE (OP"ISUB", 7, 6, 2) ;          # GEN IX7 X6-X2    #
               END
          ELSE BEGIN                              # IF CONSTANT LIMIT # 
               VV = - MAXV [LOOPL] ;               # IF SOURCE DIM. # 
               IF  LIMV [LOOPL] + VV  EQ  0         # EQ TARGET DIM. #
                 OR GETF                         # READ                #
               THEN ISSUE (OP"SBXK", 7, 6, VV) ;    # GEN SB7 X6-MAX   #
               ELSE BEGIN 
                    IF  NOT NSIF
                    THEN ISSUE (OP"SXXK", 7, 6, -LIMV [LOOPL]) ;
                    ELSE ISSUE (OP"SXXK", 7, 6, VV) ;    # SX7 X6 - VV #
                    END 
               END                                # FOR ALL CASES # 
          CALL SAR (6, RK"SYM", IV, 0) ;            # GEN SA6 INDEXVAR #
          IF  NULV [LOOPL] NE 0                   # IF WRITING AND (VAR#
          THEN BEGIN                                # DIM OR SOURCE DIM#
               ISSUE (OP"SBXK", 7, 6, - MAXV [LOOPL]) ; # < TARGET DIM)#
               VV = TEMV [NULV [LOOPL]] ;           # GEN SB7 X6-MAX   #
               CALL SAR (7, RK"SYM", VV, 0) ;       # GEN SA7 NULFLVAR #
               END
          IF  NOT GETF                            # IF WRITING, OR IF # 
            OR  NOT LIMF [LOOPL]                   # READING AND FIXED #
          THEN BEGIN                                # DIMENSION # 
               IF  NOT NSIF 
               THEN ISSUE (OP"COPY", 6, 3, 3) ;     # GEN BX6 X3       #
               ISSUE (OP"LEFTB", 7, 0, 4) ;         # GEN LX7 X4       #
               IF  NOT NSIF 
               THEN CALL SAR (6, RK"SYM", SV, 0) ;  # GEN SA6 SOFFSET  #
               CALL SAR (7, RK"SYM", TV, 0) ;       # GEN SA7 TOFFSETV #
               END
          IF  GETF  AND  LIMF [LOOPL]             # IF READING AND #
          THEN BEGIN                               # VAR. DIMENSION # 
               ISSUE (XNO, RT"SYM") ;               # GEN MI,X7 BEGLOOP#
               ISSUE (OP"XC", XC"MI", 7, BEGL [LOOPL]) ;
               END
          ELSE BEGIN                              # FOR ALL OTHER CASES#
               ISSUE (XNO, RT"SYM") ;               # GEN MI,B7 BEGLOOP#
               ISSUE (OP"LT", 7, 0, BEGL [LOOPL]) ; 
               END
          NSIF == NSGF[LOOPL];                   # RESTORE NSIF        #
  
#         CLEAR LOOP CONTROL TABLE ENTRY. 
# 
          TEMF [INDV [LOOPL]] = FALSE ;           # RELEASE TEMPORARY  #
          IF  LIMF [LOOPL]                        # VARIABLES - INDEX, #
          THEN TEMF [LIMV [LOOPL]] = FALSE ;      # LIMIT, NULL FLAG,  #
          IF  NULV [LOOPL] NE 0                   # SOURCE AND TARGET  #
          THEN TEMF [NULV [LOOPL]] = FALSE ;      # OCCURRENCE OFFSETS #
          IF  SOFV [LOOPL] NE 0 
          THEN TEMF [SOFV [LOOPL]] = FALSE ;
          IF  TOFV [LOOPL] NE 0 
          THEN TEMF [TOFV [LOOPL]] = FALSE ;
          LOOPL = LOOPL - 1 ;                     # REMOVE LOOP ENTRY # 
          RETURN ;
  
  
  
  
#***      SLC  -  SET LOOP CONTROLS.
# 
          XDEF PROC SLC ; 
          PROC SLC ;
  
#         *SLC* IS CALLED AT THE START OF A LOOP TO PROCESS A 
*         REPEATING (GROUP OR ELEMENTARY) ITEM, TO CREATE AN
*         ENTRY IN THE *LOOP* TABLE AND ISSUE CODE AT THE TOP 
*         OF THE LOOP.
****
# 
          BEGIN 
  
          ITEM I, J, K, L, M, N ;  # TEMPORARIES #
          ITEM NULL ;              # NULL-JUMP LABEL TSYM INDEX # 
          ITEM SOFS ;              # SOURCE FIRST OCCURRENCE OFFSET # 
          ITEM TOFS ;              # TARGET FIRST OCCURRENCE OFFSET # 
  
          CALL DSR ;                    # DEPOSIT STORE REGISTER #
          NULL = 0 ;
          LOOPL = LOOPL + 1 ;           # CREATE NEW LOOP TABLE ENTRY # 
          LOOP0 [LOOPL] = 0 ; 
          LOOP1 [LOOPL] = 0 ; 
          LOOP2 [LOOPL] = 0 ; 
          LOOP3 [LOOPL] = 0 ; 
          LLEV [LOOPL] = TLEV ;         # SET TARGET ITEM LEVEL NUMBER #
          INDV [LOOPL] = GTV ;          # ALLOCATE INDEX VARIABLE # 
          LIMF [LOOPL] = FALSE ;        # ASSUME CONSTANT DIMENSION # 
          NSGF [LOOPL] = NSIF ;         # NO SOURCE ITEM FLAG          #
          IF  GETF
  
#         SETUP *LOOP* TABLE ENTRY FOR READING (TARGET = SUB-SCHEMA). 
# 
          THEN BEGIN
               TOFS = SBITMBWP [SSIP] * WL + SBITMBBP [SSIP] ;
               I = SSIP + SBITMOCCURP [SSIP] ;    # POINT TO OCCURS WD #
               MAXV [LOOPL] = SBITMHIBNDS [I] ;   # MAX LIMIT VALUE # 
               IF  NSIF                 # IF NO SOURCE ITEM # 
               THEN BEGIN                # MAP VECTOR TO GROUP NEST # 
  
                    # SCAN FORWARD IN SUB-SCHEMA DIRECTORY TO FIND AN  #
                    # ITEM/VECTOR/GROUP THAT DOES HAVE A CORRESPONDING #
                    # VECTOR/GROUP IN THE SCHEMA, AND ACCUMULATE SUM   #
                    # OF OFFSETS AND PRODUCT OF DIMENSIONS, BUT IGNORE #
                    # NON-REPEATING GROUPS.                            #
  
                    FOR  J = NEXT 
                            STEP  SBITMNEXTP [J]
                            WHILE  NSIF  DO 
                         BEGIN
                         IF  SBITMTYPE [J] NE TYPE"SIMPLGRP"
                           AND  SBITMLEVEL [J] NE 50
                           AND  NOT SBITMREDEFFG [J]
                         THEN BEGIN 
                              TOFS = TOFS + SBITMBWP [J] * WL + 
                                                  SBITMBBP [J] ;
                              IF  SBITMOCCURP [J] NE 0
                              THEN BEGIN
                                   I = J + SBITMOCCURP [J] ;
                                   MAXV [LOOPL] = MAXV [LOOPL] *
                                                    SBITMHIBNDS [I] ; 
                                   END
                              IF  SBITMSCPTR [J] NE 0 
                              THEN BEGIN
                                   SCIP = SBITMSCPTR [J] ;
                                   SSIP = J ; 
                                   NSIF = FALSE ; 
                         END  END  END
                    NEXT = J ;                    # UPDATE SUB-SCHEMA # 
                    SSIO = SBITMORDINAL [SSIP] ;   # ITEM POINTERS #
                    END 
               LIMV [LOOPL] = SCITMINTVAL [SCIP] ;     # SOURCE DIM. #
               SOFV [LOOPL] = GTV ;     # SOURCE OCCURRENCE LOCATORS #
               SSIZ [LOOPL] = SCITEMSIZE [SCIP] * CL ;     # IN BITS #
               SOFS = SCITEMPBWP [SCIP] * WL + SCITEMBBP [SCIP] ; 
               TOFV [LOOPL] = GTV ;     # TARGET OCCURRENCE LOCATORS #
               TSIZ [LOOPL] = SBITMUSESIZE [SSIP] * CL ;   # IN BITS #
               IF  SBITMSYNC [SSIP]         # ROUND UP IF SYNCHRONISED #
               THEN TSIZ [LOOPL] = ((TSIZ [LOOPL] + WL - 1) / WL) * WL ;
               END
  
#         SETUP *LOOP* TABLE ENTRY FOR WRITING (TARGET = SCHEMA). 
# 
          ELSE BEGIN
               MAXV [LOOPL] = SCITMINTVAL [SCIP] ;  # MAX LIMIT VALUE # 
               IF  NSIF 
               THEN BEGIN               # IF NO SOURCE ITEM # 
                    LIMV [LOOPL] = 0 ;
                    SOFV [LOOPL] = 0 ;       # CLEAR LOOP CONTROLS #
                    SSIZ [LOOPL] = 0 ;        # FOR SOURCE GROUP #
                    SOFS = 0 ;
                    I = 0 ; 
                    END 
               ELSE BEGIN               # IF SOURCE ITEM EXISTS # 
                    SOFV [LOOPL] = GTV ;  # SOURCE OCCURRENCE LOCATORS #
                    SSIZ [LOOPL] = SBITMUSESIZE [SSIP] * CL ;# IN BITS #
                    IF  SBITMSYNC [SSIP]    # ROUND UP IF SYNCHRONISED #
                    THEN SSIZ [LOOPL] = ((SSIZ[LOOPL]+WL-1) / WL) * WL ;
                    SOFS = SBITMBWP [SSIP] * WL + SBITMBBP [SSIP] ; 
                    IF  SBITMOCCURP [SSIP] NE 0   # IF OCCURS CLAUSE #
                    THEN BEGIN
                         I = SSIP + SBITMOCCURP [SSIP] ; # POINT TO IT #
                         LIMV [LOOPL] = SBITMHIBNDS [I] ; # SOURCE DIM #
                         END
                    ELSE BEGIN                    # IF NO OCCURS #
                         I = 0 ;
                         LIMV [LOOPL] = 1 ; 
                         END
  
                    # CHECK FOR DOMINANT REPEATING GROUPS THAT HAVE NO #
                    # CORRESPONDING GROUP ENTRIES IN THE SCHEMA (BUT   #
                    # IGNORE NON-REPEATING GROUPS), AND ACCUMULATE SUM #
                    # OF OFFSETS AND PRODUCT OF DIMENSIONS.            #
  
                    FOR  J = SBITMDOMADR [SSIP] 
                            WHILE  J NE SSRP  DO
                         BEGIN
                         IF  SBITMSCPTR [J] NE 0
                         THEN J = SSRP ;
                         ELSE BEGIN 
                              IF  SBITMOCCURP [J] NE 0
                              THEN BEGIN
                                   I = J + SBITMOCCURP [J] ;
                                   LIMV [LOOPL] = LIMV [LOOPL] *
                                                     SBITMHIBNDS [I] ;
                                   SOFS = SOFS + SBITMBWP[J] * WL + 
                                                       SBITMBBP [J] ; 
                                   END
                              J = SBITMDOMADR [J] ; 
                         END  END 
                    END 
               TOFV [LOOPL] = GTV ;     # TARGET OCCURRENCE LOCATORS #
               TSIZ [LOOPL] = SCITEMSIZE [SCIP] * CL ;     # IN BITS #
               TOFS = SCITEMPBWP [SCIP] * WL + SCITEMBBP [SCIP] ; 
               IF  LOOPL GE 2 
                 AND  NULV [LOOPL-1] NE 0  # IF A CONTAINING LOOP CAN # 
               THEN BEGIN                   # HAVE NULL ITERATIONS #
                    K = TEMV [NULV [LOOPL-1]] ; 
                    LOCKX [2] = TRUE ;              # GEN SA1 NULV'    #
                    CALL GXR (J, RK"VAL", K, 0) ; 
                    IF  NOT (SCITMDIMOCC [SCIP])
                             OR  (I NE 0            # GEN SB1 1        #
                                  AND  SBITMDEPNDON [I])  # IF NEEDED # 
                      AND  LIMV [LOOPL] LE 2
                    THEN CALL SB1 ; 
                    CALL SXR (2, RK"CON", 0, 0) ;   # GEN MX2 0        #
                    NULL = TSYML ;
                    ISSUE (XNO, RT"SYM") ;          # GEN PL,X1 NULL   #
                    ISSUE (OP"XC", XC"PL", J, NULL) ; 
                    LIMF [LOOPL] = TRUE ;    # FORCE VAR-DIM MODE # 
                    END 
               END
  
#         TRY TO CHANGE OCCURRENCE LOCATORS FROM BITS TO WORDS. 
# 
          IF  LOOPL GE 2  AND  SOBF [LOOPL-1] 
            OR  (SSIZ [LOOPL] / WL) * WL  NE  SSIZ [LOOPL]
            OR  (SOFS / WL) * WL  NE  SOFS
          THEN SOBF [LOOPL] = TRUE ;
          ELSE BEGIN                                   # CHANGE SOURCE #
               SOBF [LOOPL] = FALSE ;                   # LOCATORS    # 
               SSIZ [LOOPL] = SSIZ [LOOPL] / WL ;        # TO WORDS  #
               SOFS = SOFS / WL ; 
               END
          IF  LOOPL GE 2  AND  TOBF [LOOPL-1] 
            OR  (TSIZ [LOOPL] / WL) * WL  NE  TSIZ [LOOPL]
            OR  (TOFS / WL) * WL  NE  TOFS
          THEN TOBF [LOOPL] = TRUE ;
          ELSE BEGIN                                   # CHANGE TARGET #
               TOBF [LOOPL] = FALSE ;                   # LOCATORS    # 
               TSIZ [LOOPL] = TSIZ [LOOPL] / WL ;        # TO WORDS  #
               TOFS = TOFS / WL ; 
               END
  
#         IF *OCCURS DEPENDING ON* SPECIFIED, GENERATE CODE 
*         TO EVALUATE THE VARIABLE DIMENSION. 
# 
          IF  SCITMDIMOCC [SCIP]        # IF SCHEMA ITEM HAS #
            AND  (GETF  OR  NOT NSIF)    # VARIABLE DIMENSION # 
          THEN BEGIN
               LIMF [LOOPL] = TRUE ;         # SET VARIABLE DIMENSION # 
               LIMV [LOOPL] = GTV ; 
               IF  LOOPL EQ 1 
               THEN VARF = TRUE ; 
               FOR  J = SCIP                 # FIND VARDIM ITEM # 
                    STEP  - SCITEMPRIORP [J]
                    WHILE  SCITMORDNUM [J] NE SCITMDEPORDL [SCIP] 
                    DO  BEGIN  END
               IF  SCITEMCLASS [J] EQ CLASS"INTEGER"
                 AND  SCITEMPTLOC [J] EQ 0
               THEN BEGIN                    # IF VARDIM ITEM IN #
                    L = SCITEMPBWP [J] ;      # THE SCHEMA IS A # 
                    IF  GETF                   # BINARY INTEGER # 
                    THEN K = RK"SRW" ;
                    ELSE K = RK"TRW" ;
                    CALL SXR (2, K, 0, L) ;         # GEN SA2 VDITEM   #
                    END 
               ELSE 
               IF  I NE 0 
                 AND ( SBITMDBCLASS [SBITMOCCLDNA [I]] EQ 
                           CLASS"INTEGER" 
                       OR  SBITMDBCLASS [SBITMOCCLDNA [I]] EQ 
                           CLASS"FTNLOGICAL"
                       OR  SBITMDBCLASS [SBITMOCCLDNA [I]] EQ 
                           CLASS"FTNBOOLEAN" )
                 AND  SBITMPTLOC [SBITMOCCLDNA [I]] EQ 0
               THEN BEGIN                    # IF VARDIM ITEM EXISTS IN#
                    L = SBITMBWP [SBITMOCCLDNA [I]] ; # THE SUB-SCHEMA #
                    IF  GETF                   # AND IT IS A #
                    THEN K = RK"TRW" ;          # BINARY INTEGER #
                                             # OR FTN TYPES EQUIVALENT #
                                             # TO BINARY INTEGER       #
                    ELSE K = RK"SRW" ;
                    CALL SXR (2, K, 0, L) ;         # GEN SA2 VDITEM   #
                    END 
               ELSE BEGIN 
                    I = SSIP ;
                    SSIP = 0 ;
                    IF  GETF
                    THEN K = RK"SRA" ;       # MUST GENERATE CODE # 
                    ELSE K = RK"TRA" ;        # TO CONVERT SCHEMA # 
                    L = SCITEMPTLOC [J] ;      # VARDIM ITEM TO A # 
                    IF  NOT SCITEMPTLEFT [J]    # BINARY INTEGER #
                    THEN L = - L ;
                    N = LOOPL ; 
                    LOOPL = 0 ; 
                    SBBP = SCITEMBBP [J] ;
                    SBWP = SCITEMPBWP [J] ; 
                    SI = 0 ;
                    SW = SBWP ; 
                    TBBP = 0 ;
                    TBWP = 0 ;
                    TI = TEMV [LIMV [N]] ;        # GENERATE ITEM CONV #
                    TW = 0 ;
                    CALL GIC (SCITEMCLASS [J], K, 
                              SCITEMSIZE [J] * CL, 0, L,
                              SCITEMACTLPT [J], SCITEMSIGNFG [J], 
                              CLASS"INTEGER", RK"SYM",
                              WL, 0, 0, 0, 0) ; 
                    CALL DSR ;                    # DEPOSIT STORE REG. #
                    LOOPL = N ; 
                    CALL SXR (2, RK"VAL", TEMV [LIMV [LOOPL]], 0) ; 
                    SSIP = I ;                      # GEN SA2 LIMV     #
               END  END 
          ELSE                          # SCHEMA ITEM IS FIXED DIM. # 
          IF  I NE 0
            AND  (GETF  OR  NOT NSIF) 
            AND  SBITMDEPNDON [I]       # IF SUB-SCHEMA ITEM EXISTS # 
          THEN BEGIN                     # AND HAS VARIABLE DIMENSION # 
               LIMF [LOOPL] = TRUE ;
               LIMV [LOOPL] = GTV ; 
               IF  LOOPL EQ 1  AND  GETF
               THEN VARF = TRUE ; 
               J = SBITMOCCLDNA [I] ;        # FIND VARDIM ITEM # 
               IF  SBITMDBCLASS [J] EQ CLASS"INTEGER" 
                 AND  SBITMPTLOC [J] EQ 0 
                                             #(NOTE THAT THERE IS NO   #
                                             # CHECK HERE FOR FTN TYPES#
                                             # EQUIVALENT TO BINARY    #
                                             # INTEGER. IN FORTRAN,    #
                                             # SUBSCHEMA ITEMS ARE     #
                                             # NEVER VARDIM IF SCHEMA  #
                                             # ITEM IS FIXED DIM.     )#
               THEN BEGIN 
                    L = SBITMBWP [J] ;       # IF VARDIM ITEM IN #
                    IF  GETF                  # SUB-SCHEMA IS A # 
                    THEN K = RK"TRW" ;         # BINARY INTEGER # 
                    ELSE K = RK"SRW" ;
                    CALL SXR (2, K, 0, L) ;         # GEN SA2 VDITEM   #
                    END 
               ELSE BEGIN 
                    I = SSIP ;
                    SSIP = 0 ;               # NO, GENERATE CODE TO # 
                    IF  GETF                  # CONVERT SUB-SCHEMA #
                    THEN K = RK"TRA" ;         # VARDIM ITEM TO A # 
                    ELSE K = RK"SRA" ;          # BINARY INTEGER #
                    N = LOOPL ; 
                    LOOPL = 0 ; 
                    L = SBITMPTLOC [J] * (2 * SBITMLFTPT [J] - 1) ; 
                    SBBP = SBITMBBP [J] ; 
                    SBWP = SBITMBWP [J] ; 
                    SI = 0 ;
                    SW = SBWP ; 
                    TBBP = 0 ;
                    TBWP = 0 ;
                    TI = TEMV [LIMV [N]] ;        # GENERATE ITEM CONV #
                    TW = 0 ;
                    CALL GIC (SBITMDBCLASS [J], K,
                              SBITMUSESIZE [J] * CL,
                              SBITMJUST [J], L, 
                              SBITMACTLPT [J], SBITMSIGNF [J],
                              CLASS"INTEGER", RK"SYM",
                              WL, 0, 0, 0, 0) ; 
                    CALL DSR ;                    # DEPOSIT STORE REG. #
                    LOOPL = N ; 
                    CALL SXR (2, RK"VAL", TEMV [LIMV [LOOPL]], 0) ; 
                    SSIP = I ;                      # GEN SA2 LIMV     #
               END  END 
          ELSE BEGIN                    # BOTH ARE FIXED DIMENSION #
               IF  LIMF [LOOPL] 
               THEN BEGIN               # IF IN A VARIABLE LOOP # 
                    CALL SXR (2, RK"CON", LIMV [LOOPL], CF"INT") ;
                                                    # GEN SX2 LIMV     #
                    LIMV [LOOPL] = GTV ;     # TREAT AS VAR. DIM. # 
               END  END 
  
#         GENERATE CODE TO INITIALISE LOOP CONTROL VARIABLES. 
# 
          LOCKX [2] = TRUE ;
          IF  LIMF [LOOPL]              # IF VARIABLE DIMENSION # 
          THEN BEGIN                         # IF NULL LABEL NEEDED # 
               IF  NULL NE 0                        # GEN NULL LABEL   #
               THEN ISSUE (XLABEL, NULL) ;
               ISSUE (OP"COPY", 7, 2, 2) ;          # GEN BX7 X2       #
               REGX  [7] = 0 ;
               LOCKX [7] = TRUE ; 
               CALL SXR (1, RK"CON", -1, CF"INT") ; # GEN MX1 -1       #
               LOCKX [1] = TRUE ; 
               END                      # IF FIXED DIMENSION #
          ELSE BEGIN
               CALL SXR (6, RK"CON", 0, 0) ;        # GEN BX6 0        #
               LOCKX [6] = TRUE ; 
               END
          CALL SB1 ;                    # SET (B1) = 1 IF NEEDED #
          IF  LOOPL EQ 1
          THEN BEGIN                    # IF NO OUTER LOOP #
               IF  SOFS NE 0
               THEN CALL SXR (3, RK"CON", SOFS, CF"INT") ;
               ELSE BEGIN 
                    ISSUE (OP"SXBB", 3, 0, 0) ; # IF NO INITIAL OFFSET #
                    REGX  [3] = 0 ;                 # GEN SX3 B0       #
                    KINDX [3] = RK"CON" ;       # ELSE #
                    ITEMX [3] = -1 ;                # GEN SX3 SOFS     #
                    VALUX [3] = 0 ;             # UNCONDITIONALLY # 
                    END                             # GEN SX4 TOFS     #
               CALL SXR (4, RK"CON", TOFS, CF"INT") ; 
               END
          ELSE BEGIN                    # IF THIS LOOP IS NESTED #
  
#         GENERATE CODE TO INITIALISE SOURCE OFFSET FOR NESTED LOOP.
# 
               K = TEMV [SOFV [LOOPL-1]] ;
               IF  (SOBF [LOOPL-1]        # PROCESS SOURCE OFFSET # 
                    OR  NOT SOBF [LOOPL]) 
                 AND  SOFS EQ 0              # IF NO ARITH. NEEDED #
               THEN CALL SXR (3, RK"VAL", K, 0) ;   # GEN SA3 SOFV'    #
               ELSE BEGIN                    # ELSE # 
                    CALL GXR (L, RK"VAL", K, 0) ;   # GEN SAL SOFV'    #
                    LOCKX [L] = TRUE ;
                    N = L ; 
                    END 
               IF  SOFS NE 0                 # IF INITIAL OFFSET #
               THEN BEGIN                           # GEN SXK SOFS     #
                    CALL GXR (K, RK"CON", SOFS, CF"INT") ;
                    LOCKX [K] = TRUE ;
                    END 
               IF  SOBF [LOOPL] 
                 AND  NOT SOBF [LOOPL-1]
               THEN BEGIN                    # IF OUTER WDS, INNER BITS#
                    CALL FXR (M, RK"CON", WL, 0) ;
                    IF  M LT 0
                    THEN BEGIN                      # GEN SXM 60       #
                         M = 0 ;
                         IF  LOCKX [0]
                         THEN CALL FXR (M, RK"NUL", 0, 0) ; 
                         CALL SXR (M, RK"CON", WL, CF"INT") ; 
                         END
                    LOCKX [M] = TRUE ;
                    IF  SOFS EQ 0 
                    THEN N = 3 ;
                    ELSE CALL FXR (N, RK"NUL", 0, 0) ;
                    LOCKX [L] = FALSE ;      # IF INITIAL OFFSET #
                    ISSUE (OP"DMUL", N, L, M) ;     # GEN IXN XL*XM    #
                    REGX [N] = 0 ;           # IF NONE #
                    END                             # GEN IX3 XL*XM    #
               IF  SOFS NE 0
               THEN BEGIN                    # IF INITIAL OFFSET #
                    ISSUE (OP"IADD", 3, N, K) ;     # GEN IX3 XN+XK    #
                    LOCKX [N] = FALSE ; 
                    LOCKX [K] = FALSE ; 
                    REGX [3] = 0 ;
                    END 
               LOCKX [3] = TRUE ;            # RESULT IS IN X3 #
  
#         GENERATE CODE TO INITIALISE TARGET OFFSET FOR NESTED LOOP.
# 
               K = TEMV [TOFV [LOOPL-1]] ;
               IF  (TOBF [LOOPL-1]        # PROCESS TARGET OFFSET # 
                    OR  NOT TOBF [LOOPL]) 
                 AND  TOFS EQ 0              # IF NO ARITH. NEEDED #
               THEN CALL SXR (4, RK"VAL", K, 0) ;   # GEN SA4 TOFV'    #
               ELSE BEGIN                    # ELSE # 
                    CALL GXR (L, RK"VAL", K, 0) ;   # GEN SAL TOFV'    #
                    LOCKX [L] = TRUE ;
                    N = L ; 
                    END 
               IF  TOFS NE 0                 # IF INITIAL OFFSET #
               THEN BEGIN                           # GEN SXK TOFS     #
                    CALL GXR (K, RK"CON", TOFS, CF"INT") ;
                    LOCKX [K] = TRUE ;
                    END 
               IF  TOBF [LOOPL] 
                 AND  NOT TOBF [LOOPL-1]
               THEN BEGIN                    # IF OUTER WDS, INNER BITS#
                    CALL FXR (M, RK"CON", WL, 0) ;
                    IF  M LT 0
                    THEN BEGIN                      # GEN SXM 60       #
                         M = 0 ;
                         IF  LOCKX [0]
                         THEN CALL FXR (M, RK"NUL", 0, 0) ; 
                         CALL SXR (M, RK"CON", WL, CF"INT") ; 
                         END
                    LOCKX [M] = TRUE ;
                    IF  TOFS EQ 0 
                    THEN N = 4 ;
                    ELSE CALL FXR (N, RK"NUL", 0, 0) ;
                    LOCKX [L] = FALSE ;      # IF INITIAL OFFSET #
                    ISSUE (OP"DMUL", N, L, M) ;     # GEN IXN XL*XM    #
                    REGX [N] = 0 ;           # IF NONE #
                    END                             # GEN IX4 XL*XM    #
               IF  TOFS NE 0
                    THEN BEGIN               # IF INITIAL OFFSET #
                    ISSUE (OP"IADD", 4, N, K) ;     # GEN IX4 XN+XK    #
                    LOCKX [N] = FALSE ; 
                    LOCKX [K] = FALSE ; 
                    REGX [4] = 0 ;
                    END 
               LOCKX [4] = TRUE ;            # RESULT IS IN X4 #
               END
  
#         GENERATE REMAINDER OF LOOP INITIALISING CODE. 
# 
          IF  LIMF [LOOPL]
          THEN BEGIN                    # IF VARIABLE DIMENSION # 
               ISSUE (XNO, RT"SYM") ;               # GEN SA7 LIMV     #
               ISSUE (OP"SABK", 7, 0, TEMV [LIMV [LOOPL]]) ;
               END
          IF  NOT GETF                  # IF WRITING AND (VAR. DIM. OR #
            AND  (LIMF [LOOPL]           # LIMIT LESS THAN MAX LIMIT) # 
                  OR  LIMV [LOOPL] LT MAXV [LOOPL]) 
          THEN NULV [LOOPL] = GTV ;          # CREATE NULV TEMP # 
          ELSE NULV [LOOPL] = 0 ; 
          ENDL [LOOPL] = TSYML ;        # CREATE END-LOOP LABEL # 
          ISSUE (XNO, RT"SYM") ;
          ISSUE (OP"EQ", 0, 0, ENDL [LOOPL]) ;      # GEN EQ  ENDL     #
  
#         GENERATE BEGINNING CODE OF LOOP BODY. 
# 
          BEGL [LOOPL] = TSYML ;        # CREATE BEGIN-LOOP LABEL # 
          ISSUE (XLABEL, BEGL [LOOPL]) ;            # GEN BEGL LABEL   #
          CALL CRA ;                    # CLEAR REGISTER ASSOCIATES # 
          ITEMB [1] = 1 ; 
          KINDX [3] = RK"VAL" ;              # EXCEPT THAT (B1) = 1, #
          ITEMX [3] = TEMV [SOFV [LOOPL]] ;   # (X3) = VAL SOFV, AND #
          LOCKX [3] = TRUE ;                  # (X4) = VAL TOFV  #
          KINDX [4] = RK"VAL" ; 
          ITEMX [4] = TEMV [TOFV [LOOPL]] ; 
          LOCKX [4] = TRUE ;
          RETURN ;
  
          END 
  
     END  TERM
