*DECK GSET
          IDENT  GSET 
          TITLE  GSET - SET STATEMENT MAIN CODE GENERATOR 
  
          MACHINE  ANY,I
  
          SST 
          COMMENT  SET STATEMENT PROCESSOR
 GSET     SPACE  4
* 
**        GSET - SET STATEMENT PROCESSOR
* 
*                THE VARIOUS TYPES OF SETS ARE HANDLED BY 
*                SEPERATE SUB-GENERATORS: 
* 
*         GENSET -  SET ID-1 TO ID-2. 
*                   SET ID-1 UP/DOWN BY I.
* 
*         GSETCOL - SET COLLATING SEQUENCE
* 
*         GSETSSW - SET SWITCH-NAME 
* 
* 
*                J.P. WADDELL      12/10/74 
* 
*         COMMON DECK CALLS FOLLOW... 
* 
  
 GSET     MODULE
          TITLE  DEFINITIONS AND LINKAGES 
  
*      INPUT REGISTERS: 
  
 SREGA    EQU    REGA              VERB 
 SREGB    EQU    REGB              SUB-VERB 
 SREGC    EQU    REGC              SENDING FILED
 SREGD    EQU    REGD              RECIEVING FILED
  
*      REGISTERS FOR PARAMTER STORAGE AND PASSING 
  
 SREGI    EQU    REGI              ALSO USED BY GCONDIT 
 SREGT    EQU    REGT              FOR DUMMY DNATS
 SREG11   EQU    REG11
 SREGU1   EQU    REGU1
  
  
*      VIRTUAL REGISTERS: 
  
 SVREG1   EQU    VREG1
 SVREG2   EQU    VREG2
 SVREG3   EQU    VREG3
  
*      FOR USE BY LOADIX ONLY 
  
 IVREG33  EQU    VREG33            ****LOADIX ONLY****
 IVREG34  EQU    VREG34            ****LOADIX ONLY****
  
  
*      ENTRY POINTS 
 GENSET   KNIL   CGSET
 GSETSSW  KNIL   CGSETSW
 GSETCOL  KNIL   CGSETAL
 LOADIX   KNIL   LOADIX 
  
*      EXTERNAL REFS: 
  
 CLIT2RN  LINK   CLIT2RN
 ADNAT    LINK   ADNAT
 ADPDNAT  LINK   ADPDNAT
 CGMOVE   LINK   CGMOVE 
 SUBDNAT  LINK   SUBDNAT
 CRN2BIN  LINK   CRN2BIN
 LITPOOL  LINK   LITPOOL
OCCLEN    LINK   OCCLEN 
 REGMOVE  LINK   CGREGMV
  
*      MISC DEFNS 
  
 SETERR   EQU    77 
 SWERR    EQU    78 
 COLERR   EQU    79 
  
 SETERR1  EQU    SETERR*100+1      UNKNOWN SUBVERB
 SETERR2  EQU    SETERR1+1         ILLEGAL DATA TYPE
 SETERR3  EQU    COLERR*100+1      ILLEGAL SET SEQUENCE 
  
 SB0      EQU    R0 
 SB1      EQU    R1 
  
 CSUSE1   CONSTANT  7LC.UNICY      UNIVAC TO CYBER XLATOR 
 CSUSE2   CONSTANT  6LC.XTAB       TRANSLATE TABLE
 CSUSE3   CONSTANT  7LC.6TO12 
 CSUSE4   CONSTANT  7LC.12TO6 
 GENSET   TITLE  GENSET - SET TO OR SET UP/DOWN BY PROCESSOR
**        GENSET - SET I TO J OR SET I UP/DOWN BY J PROCESSOR 
* 
*                THIS PROCESSOR IS MADE UP OF 3 SUBPROCESSOR: 
*                            SETTO     GENS SET TO... 
*                            SETUPDN   GENS SET UP BY AND SET DOWN BY 
*                            LOADIX    GENS LOAD AN INDEX AS COMP-1 
*                                      (USED BY THIS AND OTHER PROCESSOR
*                                      S AS A SUBROUTINE).
* 
* 
  
 GENSET   EGO    1
  
          GOTOCASE (GSCODEOF,SREGB) 
            CASE   GSETTO,SETTO 
            CASE   GSETUPBY,SETUPDN 
            CASE   GSETDOWN,SETUPDN 
          ENDCASE 
  
          ERROR  SETERR1           UNKNOWN SUBVERB
  
  
 SETTO    EJECT 
**        SETTO - SET TO PROCESSOR
*                HANDLES STATEMENTS OF THE FORM 
* 
*                <SET INDEX TO ITEM>
* 
*         GENERATES 
* 
*         CASE 1:            WHERE ITEM IS A LIT OR ANOTHER INDEX 
*                            WITH THE SAME OCCURANCE NUMBER 
*         SAI    ITEM 
*         BXJ    XI 
*         SAJ    INDEX
* 
* 
*         CASE 2:            WHERE ITEM IS NOT AN INDEX OR LITERAL
*         LOAD ITEM AS
*                REGISTER COMP-1 (INTO XA)
*         SXI    OCC LNTH 
*         IXJ    XI*XA
*         LXJ    30 
*         BXK    XK+XA
*         SAK    INDEX
* 
* 
*         CASE 2A:           BOTH ITEMS ARE INDEX-DATA ITEMS
*         SAI    ITEMC
*         BXJ    XI 
*         SAJ    ITEMD
* 
* 
*         CASE 3:            WHERE ITEM IS ANOTHER INDEX
*         CALLZ  LOADIX  [INTO XA]
*         SXI    OCC LNTH 
*         IXJ    XI*XA
*         LXJ    30 
*         BXK    XJ+XA
*         SAK    INDEX
* 
* 
*         CASE 4:            STATEMENTS OF THE TYPE 
*                            <SET ITEM TO INDEX>
* 
*         CALLZ  LOADIX 
*         CALLZ  CGMOVE 
* 
* 
  
 SETTO    EGO    2
  
          IFZ    ((GCODEOF,SREGC),EQ,GLITREF),SETTO1       CASE 1 
          GOTOCASE (TYPEOF,SREGC) 
            CASE   COMP,SETTO2         CASE 2 
            CASE   COMP1,SETTO2        CASE 2 
            CASE   INDXNAME,SETTO3     CASE 3 OR CASE 4 
            CASE   INDXDATA,SETTO2A    CASE 2 OR 2A 
            CASE   COMP2,SETTO2 
            CASE   COMP4,SETTO2 
            CASE   DPCOMP2,SETTO2 
          ENDCASE 
  
          ERROR  SETERR2           ILLEGAL DATA TYPE
  
 SETTO1   EJECT 
*         SETTO1 - CASE 1;  THE ITEM IS A LITERAL.  WE FORM A NEW 
*                LITERAL THAT LOOKS LIKE AN INDEX AND POOL IT.
* 
  
 SETTO1   EGO    3
  
  
          MOVEZ  (LITREFOF,SREGC),P1
          MOVEZ  8,P2 
          MOVEZ  0,P3 
          MOVEZ  0,P4 
          CALLZ  CLIT2RN     RETURN DISPLAY CODE LITERAL
  
          MOVEZ  0,P3 
          CALLZ  CRN2BIN     CONVERT TO BINARY
  
          CALLZ  GETOLNTH 
          SUBZ   P3,1,P3
          MULTZ  P3,P1,P2 
          MOVEZ  (SHL30OF,P2),P2
          ADDZ   P3,1,P3
          ADDZ   P3,P2,P2 
          MOVEZ  0,P1 
          MOVEZ  (EQUALS,SREG11),SREGT
          CALLZ  ADPDNAT
          MOVEZ  0,(BCPOF,SREG11) 
          MOVEZ  10,(BYTLENOF,SREG11) 
          CALLZ  POOLIT 
          NOTE   SETTO1 
  
          GEN    SLRBPK,(VREGOF,SVREG1),,((FWA$OF,SREGT)) 
          GEN    XMIT,(VREGOF,SVREG2),SVREG1
          GEN    SSRBPK,SVREG2,,((FWA$OF,SREGD))
  
          RETURN
  
  
 POOLIT   LABEL 
          EXECUTE LITPOOL 
          RETURN
  
  
 SETTO2   EJECT 
*         SETTO2 - CASE 2 
*                THIS IS THE USUAL CASE - ITEM IS NOT EITHER AN 
*                INDEX OR A LITERAL 
* 
  
 SETTO2   EGO    3
  
          MOVEZ  SREGC,SREGB
          MOVEZ  (EQUALS,SREG11),SREGT
          CALLZ  ADNAT
          MOVEZ  (EQUALS,SREG11),SREGC
  
*      SET UP DUMMY DNAT FIELDS 
  
          MOVEZ  COMP1,(TYPEOF,SREGC) 
          MOVEZ  6,(NUMLENOF,SREGC) 
          MOVEZ  0,(POINTOF,SREGC)
          MOVEZ  0,(SIGNOF,SREGC) 
          MOVEZ  0,(BCPOF,SREGC)
  
          CALLZ  CGMOVE 
  
          CALLZ  GETOLNTH    GET OCCURANCE LNTH 
          NOTE   SETTO2 
  
          GEN    SXBPK,(VREGOF,SVREG1),,P1
          GEN    SXXPK,(VREGOF,SVREG3),(TREGOF,SREGC),-1
          GEN    IMUL,(VREGOF,SVREG2),SVREG3,SVREG1 
          GEN    SHL,SVREG2,30
          GEN    LOR,(VREGOF,SVREG3),SVREG2,(TREGOF,SREGC)
          GEN    SSRBPK,SVREG3,,((FWA$OF,SREGD))
          CALLZ  SUBDNAT
          RETURN
  
 SETTO2A  SPACE  4
 SETTO2A  EGO    3
          IFZ    ((TYPEOF,SREGD),EQ,INDXNAME),SETTO2  IND-NM TO IND-DATA
*      THE FOLLOWING TEST IS FOR DISPLAY ONLY - DISPLAY OF IND DATA 
          IFZ    ((TYPEOF,SREGD),NE,INDXDATA),SETTO4  DN TO IND-DATA
          NOTE   SETTO2A
          GEN    SLRBPK,(VREGOF,SVREG1),,((FWA$OF,SREGC)) 
          GEN    XMIT,(VREGOF,SVREG2),SVREG1
          GEN    SSRBPK,SVREG2,,((FWA$OF,SREGD))
          RETURN
  
  
 SETTO3   EJECT 
*         SETTO3 - CASE 3 
*                SET INDEX TO INDEX 
* 
  
 SETTO3   EGO    3
          IFZ    ((TYPEOF,SREGD),NE,INDXNAME),SETTO4       CASE 4 
  
          MOVEZ  SREGD,SREGI       TEMP 
          MOVEZ  SREGC,SREGD
          CALLZ  GETOLNTH 
          MOVEZ  P1,P2
          PUSH   P2 
          MOVEZ  SREGI,SREGD       RESTORE
          CALLZ  GETOLNTH    GET D*S LENGTH 
          POP    P2 
  
          IFZ    (P1,NE,P2),SETTO3A    C.F. CASE 1 AGAIN
  
          NOTE   SETTO3 
          GEN    SLRBPK,(VREGOF,SVREG1),,((FWA$OF,SREGC)) 
          GEN    XMIT,(VREGOF,SVREG2),SVREG1
          GEN    SSRBPK,SVREG2,,((FWA$OF,SREGD))
          RETURN
  
  
 SETTO3A  SPACE  4
 SETTO3A  LABEL 
  
          MOVEZ  SREGC,SREGB
          MOVEZ  (EQUALS,SREG11),SREGT
          CALLZ  ADNAT
          MOVEZ  (EQUALS,SREG11),SREGC
  
          CALLZ  LOADIX 
          CALLZ  GETOLNTH    GET OCCUR LENT 
  
          NOTE   SETTO3A
          GEN    SXBPK,(VREGOF,SVREG1),,P1
          GEN    SXXPK,(VREGOF,SVREG3),(TREGOF,SREGC),-1
          GEN    IMUL,(VREGOF,SVREG2),SVREG3,SVREG1 
          GEN    SHL,SVREG2,30
          GEN    LOR,(VREGOF,SVREG3),SVREG2,(TREGOF,SREGC)
          GEN    SSRBPK,SVREG3,,((FWA$OF,SREGD))
          CALLZ  SUBDNAT
          RETURN
  
 SETTO4   EJECT 
*         SETTO4 - SET DATA-NAME TO INDEX 
* 
  
 SETTO4   EGO    3
  
          MOVEZ  SREGC,SREGB
          MOVEZ  (EQUALS,SREG11),SREGT
          CALLZ  ADNAT
          MOVEZ  (EQUALS,SREG11),SREGC
  
          CALLZ  LOADIX            LOAD INDEX 
  
          MOVEZ  SREGC,SREGB
          MOVEZ  SREGD,SREGC
  
          CALLZ  CGMOVE            STORE INTO DATA-NAME 
  
          CALLZ  SUBDNAT
          RETURN
  
  
 SETUPDN  EJECT 
**        SETUPDN - GENERATE SET UP BY AND SET DOWN BY
* 
*                            SET INDEX UP BY ITEM 
*                  ITEM MAY BE EITHER A DATA-NAME OR A LITERAL
*                            WHICH GIVES US 2 CASES 
* 
*                CASE 1      DATA ITEM
*         GENERATES 
* 
*         (LOAD VIA CGMOVE) INTO XA 
*         SAI    INDEX
*         SXJ    OCC LNTH 
*         SXK    XI          STRIP UPPER 30 BITS OFF
*         IXL    XK+XA       (OR MINUS FOR SET DOWN BY) 
*         IXM    XL*XJ
*         LXM    30 
*         BXN    XM+XL
*         SAN    AI 
* 
* 
*                CASE 2      LITERAL
*         GENERATES 
*         SAI    =30/OCC LNTH*LIT,30/LIT
*         SAJ    INDEX
*         IXK    XJ+XI
*         SAK    AJ 
* 
* 
  
 SETUPDN  EGO    2
  
          IFZ    ((GCODEOF,SREGC),EQ,GLITREF),SETUPDN1     CASE 2 
  
          MOVEZ  SREGB,SREGI       SAVE SUBVERB 
          MOVEZ  SREGC,SREGB
          MOVEZ  (EQUALS,SREG11),SREGT
          CALLZ  ADNAT
          MOVEZ  (EQUALS,SREG11),SREGC
  
*      SET UP DNAT FIELDS FOR CGMOVE
  
          MOVEZ  0,(POINTOF,SREGC)
          MOVEZ  6,(NUMLENOF,SREGC) 
          MOVEZ  0,(BCPOF,SREGC)
          MOVEZ  1,(SIGNOF,SREGC)  ITEM MAY BE SIGNED 
          MOVEZ  COMP1,(TYPEOF,SREGC) 
  
          CALLZ  CGMOVE 
          CALLZ  GETOLNTH 
  
          NOTE   SETUPDN
          GEN    SLRBPK,(VREGOF,SVREG1),,((FWA$OF,SREGD)) 
          MOVEZ  SVREG1,T1   SAVE AI
          GEN    SXBPK,(VREGOF,SVREG3),,P1
          GEN    SXXPB,(VREGOF,SVREG2),SVREG1 
  
          IFTHEN ((GSCODEOF,SREGI),EQ,GSETUPBY) 
            GEN    IADD,(VREGOF,SVREG1),SVREG2,(TREGOF,SREGC) 
          ELSEZ 
            GEN    ISUB,(VREGOF,SVREG1),SVREG2,(TREGOF,SREGC) 
          ENDIFZ
  
          GEN    SXXPK,(VREGOF,VREG4),SVREG1,-1 
          GEN    IMUL,(VREGOF,SVREG2),VREG4,SVREG3
          GEN    SHL,SVREG2,30
          GEN    LOR,(VREGOF,SVREG3),SVREG2,SVREG1
          GEN    SSRAPB,SVREG3,T1 
  
          CALLZ  SUBDNAT
          RETURN
  
 SETUPDN1 EJECT 
*         SETUPDN1 - CASE 2; THE ITEM IS A LITERAL
* 
*                HERE WE FORM AND POOL A LITERAL OF THE FORM
*         VFD    30/OCC LNTH*LIT,30/LIT 
* 
*         AND BUILD THE CODE TO LOAD AND OPERATE WITH IT. 
  
 SETUPDN1 EGO    2
  
          MOVEZ  (LITREFOF,SREGC),P1
          MOVEZ  8,P2 
          MOVEZ  0,P3 
          MOVEZ  1,P4        GET SIGNED RESULT IF ANY 
          CALLZ  CLIT2RN     LITERAL _ REG ITEM (IN P2) 
          MOVEZ  0,P3 
          CALLZ  CRN2BIN     LIT _ BINARY (IN P3) 
          MOVEZ  0,T1        CLEAR FLAG 
  
          IFZ    ((TYPEOF,SREGD),EQ,INDXDATA),SETUPDN3
  
          IFTHEN (P3,LT,0)
            MOVEZ  1,T1      SET NEG VALUE FLAG 
            SUBZ   0,P3,P3   GET ABS VALUE OF P3
          ENDIFZ
          PUSH   T1 
          CALLZ  GETOLNTH 
          MULTZ  P3,P1,P2 
          MOVEZ  (SHL30OF,P2),P2
          ADDZ   P3,P2,P2 
          MOVEZ  0,P1 
          MOVEZ  (EQUALS,SREG11),SREGT
          CALLZ  ADPDNAT
          MOVEZ  0,(BCPOF,SREG11) 
          MOVEZ  10,(BYTLENOF,SREG11) 
          CALLZ  POOLIT      (KLUDGE UNTIL EXECUTE LITPOOL WORKS) 
          POP    T1 
  
          NOTE   SETUPDN1 
          GEN    SLRBPK,(VREGOF,SVREG1),,((FWA$OF,SREGT)) 
  
 SETUPDN2 LABEL 
  
          GEN    SLRBPK,(VREGOF,SVREG2),,((FWA$OF,SREGD)) 
  
          IFZ    (T1,NE,0),SETUPDN4 
          IFTHEN ((GSCODEOF,SREGB),EQ,GSETUPBY) 
            GEN    IADD,(VREGOF,SVREG3),SVREG2,SVREG1 
          ELSEZ 
            GEN    ISUB,(VREGOF,SVREG3),SVREG2,SVREG1 
          ENDIFZ
  
          GEN    SSRAPB,SVREG3,SVREG2 
          RETURN
  
 SETUPDN3 LABEL 
          GEN    SXBPK,(VREGOF,SVREG1),,P3
          BRANCH SETUPDN2 
  
 SETUPDN4 LABEL 
          IFTHEN ((GSCODEOF,SREGB),EQ,GSETUPBY) 
            GEN    ISUB,(VREGOF,SVREG3),SVREG2,SVREG1 
          ELSEZ 
            GEN    IADD,(VREGOF,SVREG3),SVREG2,SVREG1 
          ENDIFZ
  
          GEN    SSRAPB,SVREG3,SVREG2 
          RETURN
          TITLE  SET TO/UP/DOWN MISC SUBROUTINES
 GETOLNTH EJECT 
**        GETOLNTH - RETURNS OCCURANCE LENGTH OF THE ITEM 
*                POINTED TO BY SREGD IN P1. 
* 
*                            USES SUBLVLOF TO OBTAIN THE SUBSCRIPT
*                                  LEVEL OF THE INDEX AND OCCLN1OF
*                                  (AND 2OF, ETC) TO RETURN THE 
*                                  RIGHT VALUE. 
* 
  
 GETOLNTH EGO    4
  
          MOVEZ  SREGD,P1 
          MOVEZ  (SUBLVLOF,SREGD),P2
          EXECUTE OCCLEN
          RETURN
  
  
 LOADIX   EJECT 
**        LOADIX -LOADS INDEX ITEMS AS COMP-1 
* 
*                INPUT -REGB
*                OUTPUT -  REGC (A DUMMY DNAT ENTRY)
* 
*                THE REQUIRED DNAT FIELDS WILL BE SET 
*                            POINTOF = 0
*                            NUMLENOF = 6 
*                            BYTLENOF = 10
*                            BCPOF = 0
*                            SIGNOF = 0 
*                            TYPEOF = COMP1 
* 
*         GENERATES 
* 
*         SAI    REGB 
*         SXJ    XI          J IS AVAIL THRU TREGOF FUNCTION
* 
  
 LOADIX   EGO    1
  
*      SET UP PARAMS
  
          MOVEZ  COMP1,(TYPEOF,SREGC) 
          MOVEZ  0,(POINTOF,SREGC)
          MOVEZ  6,(NUMLENOF,SREGC) 
          MOVEZ  10,(BYTLENOF,SREGC)   A FULL WORD ITEM 
          MOVEZ  0,(BCPOF,SREGC)
          MOVEZ  0,(SIGNOF,REGC)       UNSIGNED 
  
          NOTE   LOADIX 
          IFTHEN ((LEVELOF,SREGB),NE,TEMPLEVL)   REGISTER ITEM OR NO
            GEN    SLRBPK,(VREGOF,IVREG33),,((FWA$OF,SREGB))
          ELSEZ 
            MOVEZ  (TREGOF,SREGB),IVREG33 
          ENDIFZ
          GEN    SXXPB,(VREGOF,IVREG34),IVREG33 
  
          MOVEZ  IVREG34,(TREGOF,SREGC) 
          RETURN
 GSETSSW  TITLE  SET SWITCH TO ON/OFF PROCESSOR 
**        GSETSSW - GENERATE SET SWITCH ON/OFF
* 
*                SENSE SWITCHES ARE CONTAINED IN BITS 6-11 OF RA+0. 
*                THE SET CALLS AN OBJECT ROUTINE FOR SWITCHES 1-6,
*                WHICH IN TURN CALLS THE SYSTEM TO SET OR CLEAR THE 
*                SWITCHES.  THEY WILL HOLD ACCROSS JOB STEPS
* 
*         GENERATES 
* 
*         SBI    SWITCH NBR 
*         SBJ    1 IF ON, 0 IF OFF
*         RJ     =XC.SETSW
* 
* 
  
 GSETSSW  EGO    1
  
          NOTE   GSETSSW
          IFZ    ((WRDOFFOF,SREGC),GT,6),SETSSW1
  
          GEN    SBBPK,(VREGOF,SVREG1),SB0,(WRDOFFOF,SREGC)   SET SW NBR
  
          IFTHEN ((GSCODEOF,SREGB),EQ,GSETON) 
            GEN    SBBPB,(VREGOF,SVREG2),SB1,SB0   FLAG FOR SET 
          ELSEZ 
            GEN    SBBPB,(VREGOF,SVREG2),SB0,SB0   FLAG FOR CLEAR 
          ENDIFZ
  
          GENOBJ N=C.SETSW,I=(SVREG1,SVREG2)
          RETURN
          SPACE  3
 SETSSW1  LABEL 
            SUBZ   (WRDOFFOF,SREGC),7,T1
            MOVEZ  (ARITH9,T1),P1     (SWITCH - 7) MOD 60 
          SUBZ   (WRDOFFOF,SREGC),7,T1
            SUBZ   59,P1,P1           59 - ((SWITCH-7) MOD 60)
            QUOTZ  T1,60,T1 
            GEN    SLRBPK,(VREGOF,SVREG1),,((EXT$OF,C.SWTCH),T1)
            GEN    SXBPB,(VREGOF,SVREG2),,SB1 
            GEN    SHL,SVREG2,P1
            IFTHEN  ((GSCODEOF,SREGB),EQ,GSETON)
              GEN    LOR,(VREGOF,SVREG3),SVREG1,SVREG2
            ELSEZ 
              GEN    LIMP,(VREGOF,SVREG3),SVREG1,SVREG2 
            ENDIFZ
            GEN    SSRAPB,SVREG3,SVREG1,SB0 
            RETURN
  
  
 GSETCOL  TITLE  SET COLLATING SEQUENCE PROCESSOR 
**        GSETCOL - SET COLLATING SEQUENCE GENERATOR
*                HANDLES
*                            SET-SORT 
*                            SET-MERGE
*                            SET-SORT-MERGE 
*                            SET-PROGRAM
*                            SET CODE-SET 
* 
*         GENERATES 
* 
*         SB5    TYPE OF SEQ
*         SB6    SEQ NUMBER 
*         SB7    ADDR OF USER SPEC TABLE (ONLY IF B6=1) 
*         RJ     =XC.SETCS
* 
*         C.SETCS RETURNS NOTHING...
* 
*                TYPE OF SEQ: 
*                1           SET-SORT 
*                2           SET-MERGE
*                3           SET-SORT-MERGE 
*                4           SET-PROGRAM
*                5           SET CODE-SET 
* 
*         SEQ NUMBER= 
*                1           USER SPECIFIED (TABLE ADDR IN B7)
*                2           STANDARD-1 
*                3           NATIVE (FROM IP.CSET)
*                4           CDC-63 
*                5           CDC-64 
*                6           ASCII-63 
*                7           ASCII-64 
*                8           UNIVERSAL
*                9           EBCDIC 
* 
* 
*                C.SETCS DOES NOT RETURN ANY PARAMTERS.  IT CALLS 
*                C.CVCS TO DO THE ACTUAL CONVERSION FROM 7 WORD TO
*                64 WORD WEIGHT TABLES. 
* 
  
 GSETCOL  EGO    1
          NOTE   GSETCOL
          GOTOCASE (GSCODEOF,SREGB) 
            CASE  GSETSORT,GSETST 
            CASE  GSETMERG,GSETMG 
            CASE  GSETSOMR,GSETSM 
            CASE  GSETPROG,GSETPG 
            CASE   GSETCODE,GSETCS
          ENDCASE 
          ERROR  SETERR3
  
 GSETST   LABEL 
          GEN    SBBPK,(VREGOF,SVREG1),,1 
          BRANCH GSETRTN
  
 GSETMG   LABEL 
          GEN    SBBPK,(VREGOF,SVREG1),,2 
          BRANCH GSETRTN
  
 GSETSM   LABEL              (CHAINS AND WHIPS DEPT)
          GEN    SBBPK,(VREGOF,SVREG1),,3 
          BRANCH GSETRTN
  
 GSETPG   LABEL              (NO SEX IN THE FILM DEPT)
          GEN    SBBPK,(VREGOF,SVREG1),,4 
  
  
 GSETRTN  LABEL              COMMON CODE BEGINS HERE
  
          GEN    SBBPK,(VREGOF,SVREG2),,(ANTYPEOF,SREGC)
          IFTHEN ((ANTYPEOF,SREGC),NE,ANLITERA) 
            GEN    SBBPB,(VREGOF,SVREG3),SB0,SB0
          ELSEZ 
            GEN    SBBPK,(VREGOF,SVREG3),,((FWA$OF,SREGC))
          ENDIFZ
          GENOBJ N=C.SETCS,I=(SVREG1,SVREG2,SVREG3) 
          RETURN
  
  
 GSETCS   LABEL 
  
          GEN    SBBPK,(VREGOF,SVREG1),,5 
          GEN    SBBPK,(VREGOF,SVREG2),,(ANTYPEOF,SREGC)
  
          MOVEZ  0,P1 
          MOVEZ  SREGU1,P2
          CALLZ  REGMVE 
          MOVEZ  (EQUALS,GDATAREF),(GCODEOF,SREGU1) 
          MOVEZ  (FNDNATOF,SREGD),(GPTROF,SREGU1) 
  
          GEN    SBBPK,(VREGOF,SVREG3),,((FWA$OF,SREGU1)) 
          GENOBJ N=C.SETCS,I=(SVREG1,SVREG2,SVREG3) 
*      GENERATE LDSET USE TO LOAD REQUIRED ROUTINES FOR SOME CODE SETS
          GOTOCASE  (ANTYPEOF,SREGC)
            CASE   ANUNI,GSETUNI
            CASE   ANASC64,GSETCNV
            CASE   ANSTANDA,GSETCNV 
            CASE   ANEBCDIC,GSETCNV 
          ENDCASE 
          RETURN                                 RETURN -NONE OF SPECIAL
 GSETUNI  LABEL              UNIVAC CODE SET NEEDS UNI TRANSLATION
          MOVEZ  CSUSE1,T1
          MOVEZ  T1,(LDRUSE,T1) 
          MOVEZ  CSUSE2,T1
          MOVEZ  T1,(LDRUSE,T1) 
          RETURN
 GSETCNV  LABEL              ASCII OR EBCDIC NEED TRANSLATION TOO 
          MOVEZ  CSUSE3,T1
          MOVEZ  T1,(LDRUSE,T1) 
          MOVEZ  CSUSE4,T1
          MOVEZ  T1,(LDRUSE,T1) 
          RETURN
  
  
 REGMVE   LABEL 
          EXECUTE REGMOVE 
          RETURN
  
          END 
