*DECK C$INIT
          IDENT  C$INIT 
          TITLE  C$INIT - INITIALIZATION AND CONSTANTS
  
          MACHINE  ANY,I
          COMMENT  INITIALIZATION AND CONSTANTS 
          SST 
          B1=1
**     COPYRIGHT MESSAGE - EXISTS IN CB5TEXT
 CPYRIGT  BSS    0
          LIST   A
          DATA   L*"COPYRT"*
          LIST   *
          ORG    CPYRIGT
  
*CALL IODEFSC 
*CALL IOMICROS
  
          USE    /STP.END/   COMMON TO COBOL 5, 4, AND FTN
 ABTWORD  BSS    1
          USE    *
          SPACE  4
* 
*         CALLING SEQUENCE - GENERATED AS FIRST EXECUTABLE CODE 
*                RJ  C.INIT 
* 
*         GIVEN  X1 - BITS 0-17 = BINARY LEVEL - TO C.BINRY 
*                          18-59 = CONTROL CARD FLAGS - TO C.CCPAR
*                                  BITS USED AND MEANINGS IN COMMON DECK
*                                  CCPARCM
*                X2 - DATE PROGRAM COMPILED IN FORM BMM/DD/YYB
*                X3 - LIBRARY CONTAINING COMPILER - TO C.LIBNM
*                B4 - ADDRESS OF 30 CHAR PROGRAM NAME 
* 
*         DOES   SETS UP VARIOUS CONSTANTS AND TABLES WHICH OVERLAY CODE
*                PROCESSES EXECUTION DIRECTIVES 
*                CALLS C.ENTRY TO SAVE PROGRAM NAME 
* 
*         USES   ALL REGISTERS EXCEPT B1 AND A1 
* 
  
          ENTRY  C.INIT 
 C.INIT   DATA   0
          SB1    1
          SA5    C.LIBNM
          NZ     X5,C.INIT   RETURN IF WE HAVE BEEN CALLED BEFORE 
 INITBUF  BSS    0           THE REMAINDER OF CBINIT OVERLAYED FROM HERE
          SX7    A1 
          SA7    SVA1        SAVE A1 - C.ADSUB NEEDS IT FOR MSB PROGS 
          BX6    X3          LIBRARY NAME FOR COBOL5
          SA6    C.LIBNM
          BX7    X2 
          SA7    C.DTCMD     SAVE DATE COMPILED 
          BX7    X1 
          SA7    C.CCPAR
          SX7    X1 
          SA7    C.BINRY     BINARY LEVEL 
          SB5    X7 
          ZR     X7,INIT0    OLD BINARY 
          NG     X1,INIT0    JP IF MAIN SUB - C.ADSUB CALLS C.ENTRY 
          SB3    B0          MAIN PROGRAM 
          RJ     =XC.ENTRY
 INIT0    BSS    0
 NOS1     IFC    NE,/"OSNAME"/SCOPE / 
          SX1    INITTMP
          SX2    27B
          RJ     =XCPM=      CALL GETJO TO PICK UP JOB ORIGIN 
          SA1    INITTMP
 TROUT    EQU    5           TRANEX ORIGIN - DEFINE HERE UNTIL IN A TEXT
          SX1    X1-TROUT 
          NZ     X1,NOTTAF   JP IF NOT A TAF JOB
          MX6    1
          SA6    C.TAF       SET AS A TAF JOB 
          EQ     DONE1       SKIP CONTROL CARD PROCESS, ETC.
 NOTTAF   BSS    0
          MX6    0
          SA6    C.TAF       SET AS A NON-TAF JOB 
          ELSE               IF RUNNING ON NOS/BE 
          EQ     BUF300 
          BSSZ   4           ENSURE BUFFER HAS 300 BYTES
 BUF300   BSS    0
 NOS1     ENDIF 
          SA1    C.CCPAR     GET COBOL5 CONTROL CARD PARAMETERS 
          NG     X1,DONE1    JP IF MAIN SUB PROGRAM 
          SA2    B1 
          SA3    NPARMS 
          SB2    X3          COUNT OF EXECUTION CTL CARD PARAMS 
          MX0    42 
          SX7    77B         MASK 
          SB7    PARMLIST 
PARMLOOP  ZR     B2,DONE
          SB2    B2-B1
          SA2    A2+B1
          BX6    X2*X0       PARAM
          BX5    X2*X7       SEPARATOR
          SA3    B7 
          BX4    X3*X0
 CHKLIST  IX4    X4-X6
          NZ     X4,NOTIT 
          SB6    X3          JUMP ADDR
          JP     B6+0        GO DO IT 
  
 NOTIT    SA3    A3+B1
          BX4    X3*X0
          NZ     X3,CHKLIST  NOT END OF LIST
          SX5    X5-EQUP     C.F. EQUAL SIGN
          NZ     X5,PARMLOOP UNKNOWN.....IGNORE 
          SA3    C.FITNM
          NZ     X3,GOTBLK
          SX7    B2          SAVE B2 AND A2 
          LX7    30 
          SX5    A2 
          BX7    X7+X5
          SB5    A3 
          SA7    FILPTR 
          SB6    B2+2        INITIAL BLOCK LNTH 
          SB7    2           VAR LNTH..MAY SHRINK 
          RJ     =YC.GETBK   GET A CMM BLOCK FOR FILE EQUIVS
          SB7    PARMLIST 
          SA3    C.FITNM
          SX7    77B         RESTORE
          SA5    FILPTR 
          MX0    42 
          SA2    X5 
          LX5    30 
          SB2    X5          RESTORE
          SX6    0
          SA6    A5+0        CLEAR TEMP 
 GOTBLK   SB4    X3+0        ADDR TO STORE AT 
          SA3    FILPTR 
          BX6    X2*X0
          SA6    B4+X3
          SA2    A2+B1
          BX6    X2*X0
          SA6    A6+B1
          MX6    0
          SA6    A6+B1       SET END-OF-LIST
          SX6    B1+B1
          IX6    X3+X6
          SA6    A3 
          SB2    B2-B1
          EQ     PARMLOOP 
  
 TIMP     TIME   TIMEF       SET TIME FLAG
          EQ     PARMLOOP 
  
 CORP     SA7    COREF       SET CORE FLAG
          EQ     PARMLOOP 
  
 MSGP     SA7    C.SRTMS     SET SORT/MERGE MSGS ON 
          EQ     PARMLOOP 
  
 MCSP     SX5    X5-EQUP     CHECK FOR EQUAL SIGN 
          NZ     X5,PARMLOOP
          SA2    A2+B1       PICK UP APPLICATION NAME 
          BX6    X2*X0
  
*                            SPACE FILL THE APPLICATION NAME
*                            PROCESS FIRST SEVEN BYTES RIGHT TO LEFT
*                            LAST THREE BYTES ARE ZERO
*                            TRAILING COLONS BECOME SPACES
*                            INTERIOR COLONS REMAIN COLONS
  
          SB3    8           INITIALIZE LOOP INDEX
          LX6    -12
          MX5    -6 
          SA3    =00000000000000000055B 
          EQ     L2 
 L1       MX3    0           REPLACE INTERIOR COLONS WITH COLON 
 L2       SB3    B3-B1       DECREMENT LOOP INDEX 
          LX6    -6          SHIFT
          EQ     B3,L3       JUMP AFTER PROCESSING 7 CHARACTERS 
          BX7    -X5*X6      ISOLATE RIGHTMOST CHARACTER
          NZ     X7,L1
          BX6    X6+X3       REPLACE ZERO WITH SPACE OR ZERO
          EQ     L2 
 L3       SA6    C.APPLE
          SB2    B2-B1
          EQ     PARMLOOP 
  
 NOTRIPP  BSS    0           NO TRIPLE SPACES ALLOWED FOR WRITE ADVANCE 
          SA7    C.TRPSP
          EQ     PARMLOOP 
  
 DONE     SA2    FILPTR 
          SA3    C.FITNM
          ZR     X3,DONE1    NO BLOCK 
          LX3    30 
          SX3    X3 
          IX3    X3-X2       UNUSED 
          ZR     X3,DONE1 
          SB6    A3 
          SB7    X3-1 
          RJ     =YC.SHBLK   SHRINK THE BLOCK 
 DONE1    SA1    ABTJMP 
          MX6    0
          BX7    X1 
          SA7    ABTWORD     SET ABORT ADDRESS
          SA2    2           GET RA+2 
          BX6    X2 
          SA6    C.SVRA2     SAVE CONTENTS OF RA+2
          SA1    RA101       MINFL
          SA2    RA104       GET HHA
          SX6    X1 
          SA6    C.MINFL
          SX6    X2 
          SA6    C.HHA
          SA3    C.SEGFN     SEGMENTATION 
          ZR     X3,NOSEG 
          SA1    RA65 
          AX1    18          SET LOWER 18 BITS OF C.SEGFG = 1 IF
          SX2    B1           SEGMENT TO BE LOADED FROM LIBRARY 
          BX2    X2*X1
          SA4    A1-B1       UPPER 42 BITS OF C.SEGFG = NAME FROM RA+64 
          MX6    42 
          BX6    X6*X4
          BX6    X6+X2
          SA6    A3 
 NOSEG    SX6    B0 
          MX7    6
          SA6    C.MASK 
          SB7    9
          SA7    A6+1 
LP0       AX7    6           BUILD MASK TABLE 
          SB7    B7-1 
          SA7    A7+B1
          NZ     B7,LP0 
          SA5    FILLT       =10H 
          SB7    15 
          BX7    X5 
          SB6    B7          FOR NEXT LOOP
 LP1      SB7    B7-B1
          SA7    A7+B1       MAKE 15 WORDS OF BLANKS
          NZ     B7,LP1 
          SA5    C.FILLZ+10  =10H0000000000 
          BX7    X5 
 LP2      SB6    B6-B1
          SA7    A7+B1
          NZ     B6,LP2 
          MX6    0
          SB6    LASTZRE-FSTZRE-1  NBR TO WORDS TO ZERO 
 ZRLOOP   BSS    0
          SA6    B6+FSTZRE   ZERO OUT FLAGS AND SUCH WHICH OVERLAY CODE 
          SB6    B6-1 
          PL     B6,ZRLOOP
          SX6    BUFFS
          SA6    C.BUFFS     SIZE OF BUFFER 
          SA1    SVA1 
          SA1    X1          RESTORE A1 
          EQ     C.INIT 
 ABTJMP   EQ     C.ABORT
 NPARMS   EQU    64B         ADDR WITH NR OF PARAMS 
 EQUP     EQU    2B          = SIGN CODE
 TERMP    EQU    17B         TERMINATOR CODE
 FILLT    DATA   10H
* 
*         PARAM LIST..
*                FORMAT: 42/0LLIT,18/PROC ADDR
* 
 PARMLIST BSS    0
          VFD    42/5L*TIME,18/TIMP 
          VFD    42/5L*CORE,18/CORP 
          VFD    42/5L*MSGS,18/MSGP 
          VFD    42/5L*APPL,18/MCSP    MCS APPLICATION
          VFD    42/7L*NOTRIP,18/NOTRIPP  NO TRIPLE SPACE 
          DATA   0           END OF LIST
 SVA1     BSS    1
 INITTMP  DATA   0           TEMPORARY
 FILPTR   EQU    INITTMP
 CINITEND BSS    0
          ENTRY  C.ABORT
 C.ABORT  ABORT  ,ND         ABORT THE RUN
 C.LDCAP  TITLE  LOAD CAPSULE 
          TITLE  OVERLAID CONSTANTS 
          EJECT 
*         THE FOLLOWING CONSTANTS OVERLAY THE INITIALIZATION CODE 
*         THEY SHOULD STAY IN THE ORDER DEFINED 
 BEFOREO  BSS    0
          ORG    INITBUF
          ENTRY  C.BINRY
 C.BINRY  BSS    1           BINARY LEVEL 
          ENTRY  C.CCPAR
 C.CCPAR  BSS    1           CONTROL CARD PARAMETERS FOR OBJ USE
*                            FOR LIST OF PARAMS SEE COM CK CCPARCM
 NOS2     IFC    NE,/"OSNAME"/SCOPE / 
          ENTRY  C.TAF
 C.TAF    BSS    1           TAF FLAG - ZERO IF NOT, BIT 59 SET IF IT IS
 NOS2     ENDIF 
          ENTRY  C.HHA
 C.HHA    BSS    1           HIGHEST-HIGH ADDRESS 
          ENTRY  C.MINFL
 C.MINFL  BSS    1           LWA OF (0,0) OVERLAY - USED BY CBSEG 
          ENTRY  C.SMRSF
 C.SMRSF  BSS    1           S/M RETAIN SEQUENCE FLAG (NON-ZERO DEFAULT)
          ENTRY  C.SVRA2
 C.SVRA2  BSS    1           SAVED RA+2 FOR LATER USE 
          ENTRY  C.TEMP 
 C.TEMP   BSS    2           TEMPORARY CELLS FOR USE BY ANYONE
*       THE FOLLOWING 4 ITEMS MUST BE IN THIS ORDER 
*                C.MASK, C.BLANK, C.ZERO, C.ZEROS 
          ENTRY  C.MASK 
 C.MASK   BSS    11          MASK TABLE 
          ENTRY  C.BLANK
 C.BLANK  BSS    15          15 WORDS OF BLANKS 
          ENTRY  C.ZERO 
 C.ZERO   BSS    15          15 WORDS OF ZEROS (DISPLAY)
          ENTRY  C.ZEROS
 C.ZEROS  EQU    C.ZERO 
*     THE FOLLOWING ITEMS ARE ZEROED OUT BY THE INITIALIZATION PROCESS
 FSTZRE   BSS    0
          ENTRY  C.ADFTB
 C.ADFTB  BSS    1           ACCEPT/DISPLAY FILE TABLE POINTER
          ENTRY  C.LINEA
 C.LINEA  BSS    1           ADDRESS OF CURRENT LINE
          ENTRY  C.SIZER
 C.SIZER  BSS    1           SIZE ERROR FLAG
          ENTRY  C.SMIE 
 C.SMIE   BSS    1           NZ IF SORT/MERGE EXEC - 1 RELEASE, 2 RTN 
          ENTRY  C.SMSZE
 C.SMSZE  BSS    1           SIZE TO USE FOR SORT OR MERGE
          ENTRY  C.SWTCH
 C.SWTCH  BSS    2           SWITCHES 7 THROUGH 126 
 LASTZRE  BSS    0
*     END OF ZEROED OUT ENTRIES 
*     THE NEXT BUFFER OVERLAYS WHATEVER IS LEFT 
          ENTRY  C.BUFFS
 C.BUFFS  BSS    1           SIZE OF SCRATCH BUFFER 
          ENTRY  C.BUFF 
 C.BUFF   BSS    0           BUFFER FOR USE BY ANY ROUTINE
 BUFFS    EQU    CINITEND-C.BUFF
          IFLT   BUFFS,30,1 
 R        ERR    INSUFFICIENT ROOM LEFT FOR C.BUFF
          TITLE  CONSTANTS - NOT OVERLAYING 
          ORG    BEFOREO
          ENTRY  C.CNVRT
 CNVRTTBL MICRO  1,,*C.CNVRT* 
*CALL CNVRTTBL
          ENTRY  C.CNVT6
 C.CNVT6  DATA   77007700770077B       LOW 4 EVEN DIGITS MASK 
          DATA   60601177777777777777B  -1 + 10/2**6
          DATA   777700007777B         LOW 2 EVEN 12 BIT MASK 
          DATA   60600143777777777777B -1 + 10**2/2**12 
          DATA   1.E8P0      10**8, UNNORMALIZED
          DATA   60600002341777777777B  -1 + 10**4/2**24
*****  END OF C.CNVT6 DATA  **********
* 
 C.DTCMD  DATA   0
          ENTRY  C.DTCMD
          ENTRY  C.FBS
 C.FBS    DATA   10000B      SIZE OF ALL FILE BUFFERS EXCEPT -INPUT- AND
*                             -OUTPUT- - USED BY -CBSORT- 
* 
          ENTRY  C.FP1
 C.FP1    DATA   1.0
* 
 RA100    EQU    100B 
 RA101    EQU    101B 
 RA104    EQU    104B 
* 
          ENTRY  C.LIBNM
 C.LIBNM  DATA   0           LIBRARY CONTAINING COBOL5
* 
* 
          ENTRY  C.FILLZ
 C.FILLZ  DATA   0                 TABLE OF LJ-ZF ZEROS, MATCHES C.MASK 
          DATA   33000000000000000000B
          DATA   33330000000000000000B
          DATA   33333300000000000000B
          DATA   33333333000000000000B
          DATA   33333333330000000000B
          DATA   33333333333300000000B
          DATA   33333333333333000000B
          DATA   33333333333333330000B
          DATA   33333333333333333300B
          DATA   33333333333333333333B
* 
 RA65     EQU    65B
* 
* 
          ENTRY  C.SEGFN
 C.SEGFN  DATA   0
* 
* 
          ENTRY  C.SIXES
 C.SIXES  DATA   60606060606060606060B USED BY ARITHMETICS
* 
          ENTRY  C.SPACE
 C.SPACE  EQU    C.BLANK
* 
          ENTRY  C.TNTH 
 C.TNTH   DATA   6314632B    1/10 *2**24
          ENTRY  C.TRPSP
 C.TRPSP  DATA   0           NON ZERO IF NOT TRIPLE SPACE FOR WRITE ADV 
* 
* 
          ENTRY  C.USETB
 C.USETB  DATA   0                 ADDR OF IO DECLARATIVE JUMP VECTOR 
* 
* 
          ENTRY  C.LOVAL
          ENTRY  C.HIVAL
************************************************************************
*      NOTE- C.HIVAL MUST IMMEDIATELY FOLLOW C.LOVAL
************************************************************************
 C.LOVAL  DATA   1H           LOW-VALUE(S)
 C.HIVAL  DATA   0H9999999999 HIGH-VALUE(S) 
* 
 CDCS     IFNE   OP.DCS,OP.NO 
          ENTRY  C.CDCS 
 C.CDCS   DATA   0           SET "0 IF RUN USES CDCS
          ENTRY  C.SVKO 
 C.SVKO   BSS    1           WILL CONTAIN SS ORDINAL OF -START- KEY 
 CDCS     ENDIF 
* 
*         JOB TERMINATION FLAGS.. 
* 
          ENTRY  C.JTFLG
 C.JTFLG  BSS    0           TWO FLAGS, TIMEF AND COREF IN ORDER FOLLOW 
 TIMEF    DATA   0           ISSUE TIME MSG AT END
 COREF    DATA   0           ISSUE CORE USED AT END 
* 
          ENTRY  C.FITNM
 C.FITNM  DATA   0           LIST POINTER FOR FIT = S 
* 
          ENTRY  C.USERP
 C.USERP  DATA   0           POINTER TO LIST OF UPARAMS 
* 
          ENTRY  C.SRTMS
 C.SRTMS  DATA   0           SORT/MERGE MSG FLAG
* 
* 
          ENTRY  C.APPLE
C.APPLE   DATA   0           MCS APPLICATION NAME FROM *APPLE 
          END 
