*DECK C$SETCS 
          IDENT  C$SETCS
          TITLE  C$SETCS - SET COLLATING SEQUENCE 
  
          MACHINE  ANY,I
          COMMENT  SET COLLATING SEQUENCE 
          SST 
          B1=1
*CALL IOMICROS
 C.SETCS  SPACE  4
**        C.SETCS - PROCESS -SET COLLATING SEQUENCE-
*                THIS ROUTINE SUPPLIES THE INTERFACE BETWEEN THE
*                USER AND C.CVCS WHO ACTUALLY CRACKS THE WEIGHT TABLES. 
*                C.SETCS MAINTAINS ALL THE POINTERS AND ALLOCATES AND 
*                RELEASES THE STORAGE FOR THE TABLES. 
* 
*         CALLING SEQ:  
* 
*         SB5    OPERATION CODE 
*         SB6    SEQ TYPE 
*         SB7    ADDR OF USER TABLE IF B6=1; ELSE 0.
*                            NOTE: B7 = FIT ADDR IF OPN = 5.
*         RJ     =XC.SETCS
* 
* 
*         OPERATION CODES:  
*                1           SET-SORT 
*                2           SET-MERGE
*                3           SET-SORT/MERGE 
*                4           SET-PROGRAM
*                5           SET CODE-SET 
* 
*         SEQ TYPE: 
*                1           USER DEFINED 
*                3           NATIVE 
*         FOR THE REST, SEE C.CVCS DOCUMENTATION
* 
* 
*         USES: 
*                X  - 1 2 3 - 5 6 7 
*                A  - 1 2 - - - 6 7 
*                B  - - - 3 4 5 6 7    EXPECTS B1=1 
* 
*                NOTE: THE CMM INTERFACE ROUTINE MAY USE ADDITIONAL 
*                            REGISTERS NOT LISTED ABOVE.
* 
*         ENTRY POINT:  
* 
          ENTRY  C.SETCS
  
* 
*         EXTERNAL REFS:  
* 
          EXT    C.CVCS 
          EXT    C.SRTCS     SORT SEQUENCE POINTER
          EXT    C.MRGCS     MERGE SEQ PTR
          EXT    C.PRGCS     PROGRAM SEQ PTR
          EXT    C.EQCHR     EQUAL WEIGTH CHARS IN CURRENT PRG SEQ
          EXT    C.NATCS     NATIVE SEQ POINTER 
          EXT    C.GETBK     CMM INTERFACE ROUTINE - GET BLOCK
          EXT    C.FREBK     CMM INTERFACE ROUTINE - FREE BLOCK 
          EXT    C.LOVAL     WORD WITH LOW VALUE CHARS
          EXT    C.HIVAL     WORD WITH HIGH VALUE CHARS 
          EXT    C.MSG       ISSUE FATAL MESSAGE AND ABORT
  
 C.SETCS  SPACE  4
 C.SETCS  DATA   0
          JP     B5+CSJMP 
 CSJMP    EQ     *+400000B
          EQ     SETSRT 
          EQ     SETMRG 
          EQ     SETSM
          EQ     SETPGM 
          EQ     SETCS
  
 SETPGM   EJECT 
*         SETPGM - DOES SET PROGRAM COLLATING SEQUENCE
* 
* 
  
 SETPGM   BSS    0
          SA1    =XC.PRGCS
          LX1    30 
          SB5    X1 
          EQ     B6,B1,SETPGM1     USER DEFINED 
          SB4    B6-DEF.CS
          NZ     B4,SETPGM0  JP IF NOT DEFAULT COLL SEQ 
          SB6    CS.NTV      DEFAULT AND NATIVE ARE SAME
 SETPGM0  BSS    0
          EQ     B5,B6,C.SETCS     ALREADY IN USE, EXIT 
 SETPGM1  SX7    B6 
          LX7    30 
          SX6    B7 
          BX7    X6+X7
          SA7    =XC.PCSSV   SAVE NORMAL COLL SET POINTER FOR SORT
          MX6    0
          SA6    =XC.EQCHR   CLEAR EQUAL CHARACTER FLAG 
          SB4    B5-CS.NTV
          ZR     B4,SETPGM3  JP IF OLD COLL SEQ NATIVE
          SB4    B6-CS.NTV
          LX1    59-58+30    SAVED FLAG 
          PL     X1,SETPGM10 JP IF OLD COLL SEQ NOT SAVED ON CALL 
          ZR     B4,SETPGM13 JP IF NEW SEQ IS NATIVE
 SETPGM3  BSS    0
          SB5    A1          ADDR OF C.PRGCS FOR CMM CALL 
          SB7    B1          ALTERNATE POINTER FORMAT 
          SB6    64          NON-CMU; 64 WORD TABLE 
  
          RJ     =XC.GETBK   GET A BLOCK
  
          SA1    =XC.PRGCS
          SA2    =XC.PCSSV   GET SAVED NORMAL COLL SEQ PTR
          MX6    30 
          BX1    -X6*X1      ISOLATE ADDR OF BLOCK
          BX6    X6*X2       COLL SEQ TYPE
          SB7    X2          ADDR OF USER DEF COLL TABLE
          BX6    X6+X1       BUILD POINTER
          SA6    A1          TO C.PRGCS 
  
 SETPGM4  BSS    0
          BX1    X6 
          RJ     =XC.CVCS    CONVERT TABLE
          SA1    =XC.PCSSV   SAVED INPUT DAT
          AX1    30 
          SX1    X1-1        CHECK COLL SEQ TYPE
          NZ     X1,SETPGM14 NOT USER SEQ 
          SA1    =XC.PRGCS   CHECK FOR EQUAL WEIGHT CHARS 
          SB6    60 
          SX6    0
          SB7    X1+65       TERMINATION ADDR 
          MX7    0
          SB5    X1          START ADDR 
  
 SETPGM5  SX2    1
          SA1    B5 
          LX1    48D
          AX1    48D
          SB4    X1          GET NEXT CHAR
          GE     B4,B6,SETPGM6     CHAR NR GT 60
          LX2    X2,B4
          BX5    X2*X6       IS THE BIT ALREADY SET 
          NZ     X5,SETPGM7  GOT A DUP
          BX6    X6+X2       SET THE BIT
          SB5    B5+B1
          LT     B5,B7,SETPGM5     GET NEXT CHAR
          EQ     SETPGM14    DONE - GO SET LOVAL AND HIVAL
  
 SETPGM6  SB4    B4-60       CHR GE 60
          LX2    X2,B4
          BX5    X2*X7       C.F. ALREADY SET 
          NZ     X5,SETPGM7  GOT A DUP
          BX7    X7+X2       SET THE CHAR 
          SB5    B5+B1
          LT     B5,B7,SETPGM5     DO NEXT
          EQ     SETPGM14    OR GO SET HIGH-LOW VALUES
  
 SETPGM7  SX6    1
          SA6    =XC.EQCHR         SET EQUAL CHAR FLAG
          EQ     SETPGM14 
  
  
 SETPGM10 BSS    0
          ZR     B4,SETPGM12 JP IF NEW COLL SEQ IS NATIVE 
          LX1    59          REPOSITION COLL SEQ POINTER
          SX6    X1          GET BLOCK ADDR 
          SX1    B6 
          LX1    30 
          BX6    X6+X1
          SA6    A1          SET NEW PTR
          EQ     SETPGM4     GO PLUG IT 
  
  
 SETPGM12 SB7    A1 
          RJ     =XC.FREBK         GO FREE STORAGE
 SETPGM13 BSS    0
          SX6    =XC.NATCS   NON-CMU NATIVE SEQ ADDR
          SX1    3
          LX1    30 
          BX6    X1+X6
          SA6    =XC.PRGCS         RESET TO NATIVE
  
 SETPGM14 SA1    =XC.PRGCS
          SX2    X1          SAVE START ADDR
          SA1    X1          GET LOW VALUE CHAR 
          SB7    64          SET LIMIT
          SB6    A1 
          SB4    X1          CURRENT HI VALUE 
  
 SETPGM16 ZR     X1,SETPGM20
          SB5    X1+0 
          GE     B5,B4,SETPGM22    NEW HI VALUE 
          SB7    B7-B1       DECR. LIMIT
          SA1    A1+B1       GET NEXT CHAR
  
 SETPGM18 LX1    48D
          AX1    48D
          LT     B0,B7,SETPGM16    LOOP 
          SB5    X2 
          SX1    B6-B5       COMPUTE CHAR 
          RJ     SPREAD 
          SA6    =XC.HIVAL
          EQ     C.SETCS           EXIT 
  
 SETPGM20 SB5    X2 
          SX1    A1-B5       COMPUTE CHAR 
          RJ     SPREAD 
          SB7    B7-B1
          SA6    =XC.LOVAL   SET WORD 
          SA1    A1+B1
          EQ     SETPGM18 
  
 SETPGM22 SB6    A1 
          SB4    X1 
          SB7    B7-B1
          SA1    A1+B1
          EQ     SETPGM18 
 SETSRT   EJECT 
*         SETSRT - HANDLES SET SORT COLLATING SEQUENCE
* 
 SETSRT   SX6    B6 
          LX6    30 
          NE     B6,B1,SETSRT1     JP IF NOT USER-DEFINED SEQ 
          SX7    B7 
          BX6    X6+X7       MAKE COLL SEQ POINTER
 SETSRT1  BSS    0
          SA6    =XC.SRTCS
          EQ     C.SETCS
  
 SETMRG   SPACE  4
*         SETMRG - HANDLES SET MREG COLLATING SEQUENCE
* 
 SETMRG   SX6    B6 
          LX6    30 
          NE     B6,B1,SETMRG1     JP IF NOT USER-DEFINED SEQ 
          SX7    B7 
          BX6    X6+X7       MAKE COLL SEQ POINTER
 SETMRG1  BSS    0
          SA6    =XC.MRGCS
          EQ     C.SETCS
  
 SETCS    SPACE  4
**        SETCS - SET CODE-SET
*                FUNCTIONAL FOR ALL SEQUENCES.  THE I/O MODULES 
*                            WILL DO TRANSLATION ONLY IF CDST=8.
* 
*                            B7 WILL CONTAIN THE FIT ADDR.
*                            WE SIMPLY STORE B6 INTO THE FILED -CDST- 
*                                  IN THE FIT.
* 
* 
  
 SETCS    SX5    B7          FIT ADDR 
          FETCH  X5,OC,X1 
          ZR     X1,SETCS1   NOT OPEN 
          SX5    B7          RESTORE FIT ADDR 
          FETCH  X5,RC,X1    C.F. ALREADY ACTIVE FILE 
          NZ     X1,SETCSERR
 SETCS1   SX5    B7          FIT ADDR 
          SX6    B6          SEQ NR 
          STORE  X5,CDST=X6 
          EQ     C.SETCS     SCRAM
 SETCSERR SA1    C.SETCS     GET SOURCE LINE NR 
          LX1    30 
          SA1    X1-1 
          SX6    X1+0        LINE NR (WE HOPE)
          SA6    LINENR 
          SX1    #SETMSG1 
          SX3    A6 
          RJ     =XC.MSG     GO ISSUE MESSAGE AND DIE 
 LINENR   DATA   0
 SETSM    EJECT 
*         SETSM - HANDLES SET SORT-MERGE COLLATING SEQUENCE 
* 
*                THIS ROUTINE LETS SETSOM SET UP SORT-S SEQ AND THEN
*                WORRIES ABOUT MAKING MERGES THE SAME 
* 
 SETSM    SX6    B6 
          LX6    30 
          NE     B6,B1,SETSMA      JP IF NOT USER-DEFINED SEQ 
          SX7    B7 
          BX6    X6+X7       MAKE COLL SEQ POINTER
 SETSMA   BSS    0
          SA6    =XC.SRTCS
          SA6    =XC.MRGCS
          EQ     C.SETCS
  
 SPREAD   EJECT 
**        SPREAD - SPREAD HIGH OR LOW VALUE CHARS ACCROSS A WORD
* 
*         EXPECTS:  
*                CHAR RIGH JUST, ZERO FILLED IN X1
* 
*         RETURNS:  
*                10 COPIES OF CHAR IN X6
* 
*         USES: 
*                X6,X1,B5  (X1 IS LEFT INTACT)
* 
 SPREAD   DATA   0
          SB5    10 
          SX6    77B
          BX1    X1*X6
          SX6    0
  
 SPREAD1  BX6    X6+X1
          SB5    B5-1 
          LX1    6
          NZ     B5,SPREAD1 
          EQ     SPREAD 
  
  
          END 
