*DECK,    CONVERT 
          IDENT     CONVERT 
          TITLE              CONVERT - CONVERT CONSTANT TO BINARY 
          SST 
 B=CNVRT  RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
          TABLES CON
  
  
***       CONVERT  -  CONVERT CONSTANT TO BINARY. 
* 
* 
*         L.D.HARE - CDC/SUNNYVALE - DECEMBER 1974. 
* 
*                UPDATE FLOATING CONVERSION FOR 
*                COMPATIBILITY WITH FCL.
* 
*         ENTRY  (B1) = 0, CONVERT CONSTANT AND STORE.
*                (X1) = ELIST ENTRY.
* 
*         EXIT   (X1) = 30/CA,30/IH.
* 
*         ENTRY  (B1) .LT. 0, CONVERT CONSTANT ONLY.
*                (X1) = ELIST ENTRY.
* 
*         EXIT   (X1) = HIGH ORDER BITS CONVERTED CONSTANT. 
*                (X2) = LOW ORDER BITS CONVERTED CONSTANT 
*                       FOR DOUBLE PRECISION. 
* 
*         ENTRY  (B1) = 1 OR 2, STORE ONLY USER CONVERTED CONSTANT. 
*                (X1) = HIGH ORDER BITS CONVERTED CONSTANT. 
*                (X2) = LOW ORDER BITS CONVERTED CONSTANT 
*                       IF (B1) = 2.
* 
*         EXIT   (X1) = 30/CA,30/IH.
* 
*         USES REGISTER CONVENTION B1=1.
*         RETURNS B5=1 FOR COMPATIBILITY WITH EARLIER VERSIONS. 
* 
*         USES   ALL. 
* 
*         CALLS  ERPROI,ERPRO,ADDWD.
  
  
****      ERROR MESSAGES. 
  
 E.CCE    EQU    66          CONVERSION ERROR 
 E.TMD    EQU    218         TOO MANY DIGITS (INFORMATIVE)
 E.ICO    EQU    304         INTEGER OVERFLOW 
  
****
  
          TITLE  WORKING CONSTANTS AND STORAGE. 
*         WORKING STORAGE.
  
 CCBA     BSS    1           TYPE OF CALL, (B1) AT ENTRY
 CCBB     BSS    1           NUMBER OF CHARACTERS IN CONSTANT 
 CCBC     BSS    1           ELIST VALUE IN CASE OF ERROR 
 CCBD     BSS    1           SIGN OF REAL NUMBER
 CCBE     BSS    1           ORIGINAL CONSTOR ADDRESS 
 CCBF     BSS    1           CONSTANT TYPE
 CCBG     BSS    1           SCRATCH
 CCBH     BSS    1           2*NT WORD DP STORAGE 
 CCBI     BSSZ   1           INFORMATIVE ERROR FLAG 
          SPACE  4
  
*         CRACK CALLING PARAMETERS AND SET UP REGISTERS.
  
 CONVERT  ENTRY. **          ENTRY/EXIT 
          BX6    X1 
          SX7    B1+
          SB3    B1 
          SA6    CCBG        X1 FOR DISPLAY 
          SB1    1
          SA7    CCBA        (CCBA) = CLM = CALLING MODE
          GT     B3,B0,SBC   IF CLM .EQ. 1 OR 2 STORE ONLY
  
          BX7    X1 
          UX1    X1 
          SA7    CCBC        (CCBC) = ELT = ELIST AT ENTRY
          SB5    X1          (B5) = CAD = ORIGINAL CONSTOR ADDRESS
          AX1    18 
          SX6    B5 
          SB7    X1          (B7) = NCH = NUMBER OF CHARACTERS
          SA6    CCBE 
          AX1    45-18
          SX7    B7 
          BX6    X1 
          SA7    CCBB        (CCBB) = NCH 
          SB2    X1          (B2) = CTP = CONSTANT TYPE 
          SA6    CCBF        (CCBF) = CTP 
          JP     B2+CCB.JT   JP CCB.JT(TYPE)
  
*         CONVERT JUMP TABLE. 
  
 CCB.JT   BSS    0
          LOC    0
          SX1    B5 
          EQ     CCB4        T.LOG
          EQ     CDC         T.INT
          EQ     CDC         T.REAL 
          EQ     CDC         T.DBL
          EQ     *+4S15      T.CPLX  (COMPILER ERROR) 
          EQ     COC         T.OCT
          EQ     DISPLAY     T.HOL
          LOC    *O 
  
*         ERROR MESSAGE POSTER MACROS.
  
 CCB1     POSTER NR=E.CCE,SEV=FE,FMT=ELIST,TXT=CCBC,RETURN=CONVERT
  
 CCB2     POSTER NR=E.ICO,SEV=FE,FMT=ELIST,TXT=CCBC,RETURN=CONVERT
  
 CCB3     SA3    CCBI 
          ZR     X3,CCB4
          BX6    X2          SAVE RESULTS 
          BX7    X1 
          SA6    A3-B1
          SA7    A6-B1
          POSTER NR=E.TMD,SEV=INF 
          SA1    CCBG        RETURN CONVERTED VALUES AFTER POSTER 
          SA2    CCBH 
          SX6    0
          SA6    CCBI        ZERO INFORMATIVE ERROR FLAG
  
 CCB4     SA4    CCBA 
          SB5    1
          MI     X4,CONVERT  IF CONVERT AND NO STORE
          EQ     SBC         STORE
          TITLE  CDC - CONVERT DECIMAL CONSTANT 
**        CDC  -  CONVERT DECIMAL CONSTANT. 
* 
*         ENTRY  (B5) = CAD, ORIGINAL CONSTOR ADDRESS.
*                (B2) = CONSTANT TYPE.
* 
*         EXIT   IF CONSTANT TYPE = T.INT 
*                (X1) = BINARY INTEGER. 
* 
*                IF CONSTANT TYPE = T.REAL OR T.DBL 
*                (X1) = HIGH ORDER BITS DP BINARY CONSTANT. 
*                (X2) = LOW ORDER BITS DP BINARY CONSTANT.
*                (B5) = 1 
* 
*         ACTION 1.  CONVERT DISPLAY TO BINARY INTEGER CREATING 
*                    EXPONENT TO THE BASE 10 AS NECESSARY AND 
*                    PROCESS OVERFLOW CONDITION IF IT OCCURS. 
*                2.  CONVERT POST RADIX EXPONENT IF ENCOUNTERED.
*                3.  CHECK CONVERTED CONSTANT TYPE FOR LEGALITY 
*                    AND ISSUE FATAL ERROR/RETURN OR SET INFORMATIVE
*                    ERROR FLAG IF REQUIRED.
*                4.  CALL FSCALE IF TYPE IS T.DBL OR T.REAL, RETURN 
*                    IF T.INT.
* 
*         USES   ALL. 
  
 CDC      SX7    1R+
          SA2    CCBB 
          SA7    CCBD        (CCBD) = 1R+      SIGN OF RESULT 
          MX4    5           CRM = MASK(5)     CARRY MASK 
          SA0    B0          ECT = 0           EXPONENT COUNT 
          SB3    1R0
          SB4    10          WCT = 10          CHARACTER PER WORD COUNT 
          SB6    B0          EXT = 0           EXPONENT FLAG
          SB7    X2          NDG = CCBB        NUMBER OF CHARACTERS 
          MX3    10 
          LX3    60-1R0      DLS               DIGIT LEFT SHIFT MASK
          SA2    B5          CDI = CAD(I)      I = 1
          MX1    0           LO = 0            LO BITS INT. CONVERSION
          SX0    B0+         HI = 0            HI BITS INT. CONVERSION
  
*         DIGIT CONVERSION LOOP.
  
 CDC1     LX2    6           CON = SHIFT(CDI,6) 
          MX5    -6          MSK = 77B
          BX7    -X5*X2      CHAR = CON .A. MSK 
          SB2    X7 
          LX5    B2,X3
          PL     X5,CDC3     IF SHIFT(DLS,CHAR) .GE. 0  NOT A DIGIT 
          BX5    X4*X0       OVER = CRM .A. HI
          NZ     X5,CDC5     IF OVER .NE. 0  T.DBL OVERFLOW 
          SA0    A0+B6       ECT = ECT+EXT
          SX7    B2-B3       DIG = CHAR-1R0 
          IX5    X1+X1       LO1 = LO*2 
          LX1    3           LO = LO*8
          IX5    X5+X7       LO2 = LO1+DIG
          LX6    B1,X0       HI1 = HI*2 
          IX5    X5+X1       LO2 = LO2+LO 
          LX0    3           HI = HI*8
          BX1    -X4*X5      LO = LO2*COMP(CRM) 
          AX5    55          CARRY = SHIFT(LO2,-55) 
  
 CDC2     IX6    X5+X6       HI = HI1+CARRY  (NB AT ENTRY CDC2 X5=X6=0) 
          SB7    B7-B1       NDG = NDG-1
          IX0    X6+X0       HI = HI+HI1
          SB4    B4-B1       WCT = WCT-1
          ZR     B7,CDC8     IF NDG .EQ. 0  INTEGER FINISHED
          NZ     B4,CDC1     IF MORE DIGITS 
          SB5    B5+B1       I = I+1
          SA2    B5          CDI = CAD(2) 
          SB4    10          WCT = 10 
          EQ     CDC1 
  
*         CHECK CHARACTER FOR DECIMAL POINT, E OR D.
  
 CDC3     MX6    0           FOR POSSIBLE  EQ CDC2
          SB2    B2-1RF 
          MX7    0           CLEAR X7 
          MI     B2,CDC9     IF CHAR-1RF .LT. 0  MUST BE EXPONENT 
          SB2    B2+1RF-1R. 
          ZR     B2,CDC4     IF CHAR-1R. .EQ. 0  MUST BE 1R.
          SA7    CCBD        MUST BE + OR -  STORE SIGN AND IGNORE
          EQ     CDC2        LOOP 
  
 CDC4     SB2    B6 
          SB6    B0 
          NZ     B2,CDC7     IF PREVIOUS T.DBL OVERFLOW 
          SB6    -B1
          IX5    X5-X5       FOR POSSIBLE  EQ CDC2
          EQ     CDC2 
  
*         PROCESS T.DBL OVERFLOW. 
  
 CDC5     SB2    B6          EXH = EXT
          SB6    B6+B1       EXT = EXT+1
          EQ     CDC7 
  
 CDC6     MX5    -6 
          LX2    6           CON = SHIFT(CON,6) 
          BX7    -X5*X2      CHAR = CON .A. 77B 
          SB2    X7 
          LX6    B2,X3
          PL     X6,CDC3     IF SHIFT(DLS,CHAR) .GE. 0  NOT A DIGIT 
  
*         SKIP REMAINING DIGITS LOOKING FOR E OR D. 
  
 CDC7     SB7    B7-B1       NDG = NDG-1
          SA0    A0+B6       ECT = ECT+EXT
          ZR     B7,CDC8     IF NDG .EQ. 0  FINISHED
          SB4    B4-B1       WCT = WCT-1
          NZ     B4,CDC6     IF WCT .EQ. 0  MORE DIGITS 
          SB5    B5+B1       I = I+1
          SB4    10          WCT = 10 
          SA2    B5+         CON = CAD(I) 
          EQ     CDC6        LOOP 
  
*         CHECK IF INTEGER CONSTANT OR REAL CONSTANT WITHOUT P-RADIX. 
  
 CDC8     SA2    CCBF 
          SX6    B0          CLEAR X6 
          MX7    0           CLEAR X7 
          SX5    X2-T.INT 
          NZ     X5,CDC12    IF .NOT. T.INT 
  
*         CHECK IF LEGAL INTEGER CONSTANT AND SET SIGN. 
  
          MX4    -4          MSK = 17B
          BX5    -X4*X0      HI6 = HI .A. MSK 
          LX5    55          HI6 = SHIFT(HI6,55)
          BX1    X1+X5       INT = HI6+LO 
          SB5    B1 
          AX0    5
          NZ     X0,CCB2     INTEGER OVERFLOW - FATAL ERROR 
          SA5    CCBD        SIGN = 1R+ OR 1R-
          LX5    -2          SIGN = SHIFT(SIGN,58)
          AX5    60          SIGN = SHIFT(SIGN,-60) 
          BX1    X1-X5       INT = INT .XOR. SIGN 
          EQ     CCB3        EXIT...
  
*         EXPONENT PROCESSOR. 
  
 CDC9     SB7    B7-B1       NDG = NDG-1
          MX3    -6          MSK = 77B
          ZR     B7,CDC12    IF NDG .EQ. 0  FINISHED
          SB4    B4-1        WCT = WCT-1
          NZ     B4,CDC10    IF WCT .NE. 0
          SB5    B5+B1       I = I+1
          SA2    B5          CON = CAD(I) 
          SB4    10          WCT = 10 
  
 CDC10    LX2    6           CON = SHIFT(CON,6) 
          BX5    -X3*X2      CHAR = CON .A. MSK 
          SB2    X5-1R+      DIG1 = CHAR-1R+
          MI     B2,CDC11    IF DIG1 .LT. 0  IT IS A DIGIT
          SX7    -B2         MUST BE + OR - 
          AX7    B1,X7       SET X7 .T. FOR +, .F. FOR -
          EQ     CDC9        LOOP 
  
 CDC11    SB2    X5 
          LX5    B1,X6       EXP1 = EXP*2 
          LX6    3           EXP = EXP*8
          IX6    X5+X6       EXP = EXP+EXP1  (= EXP*10) 
          SX5    B2-B3       DIG = CHAR-1R0 
          IX6    X5+X6       EXP = EXP+DIG
          EQ     CDC9        LOOP 
  
*         SET FLAG FOR T.REAL OR T.OCT OVERFLOW, CALL FSCALE. 
  
 CDC12    BX7    X6-X7       FLG = FLG .XOR. EXP
          SB3    A0          EXPC = EXT 
          SB3    B3+X7       EXPC = EXPC+FLG
          BX6    X4*X0       DCK = HI .A. CRM 
          SB2    48          SCT = 48 
          NO
          AX4    B2,X1       RCK = SHIFT(LO,SCT)
          SA2    CCBF 
          SA5    CCBD 
          SX3    X2-T.DBL    TPE = TYP-T.DBL
          NZ     X6,CDC13    IF DCK .NE. 0  T.DBL OVERFLOW
          ZR     X4,CDC14    IF RCK .EQ. 0  NO T.REAL OVERFLOW
          ZR     X3,CDC14    IF TPE .EQ. 0  T.REAL OVERFLOW BUT T.DBL 
  
 CDC13    SX7    -1          SET INFORMATIVE ERROR FLAG 
          SA7    CCBI 
  
 CDC14    SB4    X2-2 
 -        RJ     FSCALE      GO AND CONVERT 
          ZR     B4,CCB3     IF NO ERROR ENCOUNTERED IN FSCALE
          EQ     CCB1 
          TITLE  SBC - STORE BINARY CONSTANT
**        SBC  -  STORE BINARY CONSTANT.
* 
*         ENTRY  (X1) = INTEGER CONSTANT OR 
*                       HIGH ORDER BITS DP CONSTANT.
*                (X2) = UNDEFINED OR
*                       LOW ORDER BITS DP CONSTANT. 
*                (B1) = 1 
* 
*         EXIT   (X1) = 30/CA,30/IH.
*                (B5) = 1 
* 
*         ACTION 1.  LOOK FOR MATCH OF (X1) IN CONTAB, IF FOUND 
*                    CHECK FOR TWO STORE AND MATCH (X2) WITH
*                    FOLLOWING CONTAB ENTRY.
*                2.  REPEAT 1. UNTIL MATCH OR CONTAB END. 
*                3.  ON SUCCESSFUL MATCH SET (X1) AND RETURN. 
*                4.  ON LAST WORD CONTAB MATCH (X1) AND IT IS A 
*                    TWO WORD STORE, STORE ONLY (X2) AND GO TO 3. 
*                5.  ON CONTAB END AND NO MATCH, STORE ONLY THEN 3. 
* 
*         USES   A. -,-,-,3,4,5,6,7 
*                B. -,1,2,3,4,5,6,- 
*                X. 0,1,-,3,4,5,6,7 
* 
*         CALLS  ADDWD. 
  
 SBC      SA3    CCBF        ENTRY. 
          SA4    O.CON
          SA5    L.CON
          SB6    X3-T.DBL    IF T.DBL  WD2 = 0
          SB2    X5+
          SA3    CCBA 
          SB4    X3-2        IF 2 WORD STORE  WW2=0 
          SB5    -B1         CA = -1
          SA3    X4          I = 1,  CLE = O.CON(I) 
  
*         SEARCH *CON* FOR MATCH, DETERMINE 2 WORD STORE. 
  
 SBC1     SB5    B5+1        CA = CA+1
          GE     B5,B2,SBC6  IF CA .GE. L.CON  END OF CONLIST 
          BX0    X1-X3
          SA3    A3+B1       I = I+1, CLE = O.CON(I)
          NZ     X0,SBC1     IF CLE-CON .NE. 0  LOOP
          MI     X0,SBC1     IF CLE-CON .EQ. -0  LOOP 
          SX4    B5+
          ZR     B6,SBC3     IF WD2 .EQ. 0  THEN TYPE .EQ. T.DBL
          ZR     B4,SBC3     IF WW2 .EQ. 0  THEN CCBA .EQ. 2
  
*         SET UP CA,I AND H FIELDS - RETURN.
  
 SBC2     SA5    =XCON. 
          LX4    30 
          BX1    X4+X5       (X1) = 30/CA,30/IH 
          SB5    B1 
          EQ     CONVERT     EXIT.
  
*         2 WORD STORE - DETERMINE MATCH OR NO MATCH NEXT WORD. 
  
 SBC3     SB3    B5+B1
          GE     B3,B2,SBC4  IF CONLIST FINISHED
          BX0    X2-X3
          NZ     X0,SBC1     IF NO MATCH 2*ND WORD
          MI     X0,SBC1     IF NO MATCH 2*ND WORD
          EQ     SBC2        2*ND WORD MATCH
  
*         FIRST WORD OF TWO WORD CONSTANT AT END OF TABLE,
*         ADD SECOND WORD.
  
 SBC4     BX6    X2          SAVE 2*ND WORD AND CA
          SX7    B5 
          SA6    CCBH 
          SA7    CCBG 
          SB5    1
  
*         STORE SECOND WORD.
  
 SBC5     ADDWD  CON,CCBH 
          SA4    CCBG 
          EQ     SBC2 
  
*         ADD WORD TO *CON*.
  
 SBC6     SX6    B2          CA = L.CON 
          SB5    B1          B5 = 1 
          SA6    CCBG        STORE PNT
          BX7    X2 
          SA7    A6+B1       STORE 2*NT WORD
          ADDWD  CON,X1      ADD 1*ST WORD TO CONTAB
          SA4    CCBA        T1 = TYPE OF CALL
          SA5    CCBF        T2 = TYPE OF CONSTANT
          SX6    X4-2        T1F = T1-2 
          SX7    X5-T.DBL    T2F = T2-T.DBL 
          ZR     X6,SBC5     IF CTP .EQ. 2  ADD 2*NT WORD 
          ZR     X7,SBC5     IF TYPE .EQ. T.DBL  ADD 2*NT WORD
          SA4    CCBG 
          EQ     SBC2 
          TITLE  COC - CONVERT OCTAL CONSTANT 
**        COC  -  CONVERT OCTAL CONSTANT. 
* 
*         ENTRY  (B5) = CAD, ORIGINAL CONSTOR ADDRESS.
* 
*         EXIT   (X1) = OCTAL CONSTANT. 
* 
*         ACTION 1.  SET MAX NUMBER OF DIGITS TO 20.
*                2.  CONVERT CHECKING FOR CHARACTER LEGALITY. 
*                3.  IF FROM 2. ILLEGAL CHARACTER = 1RB, RETURN.
*                4.  CHECK LENGTH GIVEN WITHIN LEGAL BOUNDS.
*                5.  SET INFORMATIVE FLAG IF 4. IS FALSE. 
* 
*         USES   A. -,1,2,-,4,-,6,- 
*                B. -,1,2,3,4,5,-,7 
*                X. 0,1,2,3,4,-,6,- 
  
 COC      MX6    0           OCT = 0
          SB2    10          WCT = 10 
          MX0    -6          MSK = 77B
          SA1    B5          CON = CAD(I) 
          SB7    B2+B2       NCH = 20, NUMBER OF CHARACTERS PERMITTED 
          MX4    8
          LX4    60-1R0      ODL = OCTAL DIGIT LEFT SHIFT MASK
  
*         MAIN OCTAL CONVERSION PROCESSING LOOP  (IN STACK).
  
 COC1     LX1    6           CON = SHIFT(CON,6) 
          BX2    -X0*X1      EXTRACT CHARACTER
          SB3    X2 
          LX3    B3,X4
          PL     X3,COC2     IF CHAR IS NOT AN OCTAL DIGIT
          SX2    B3-1R0      DIG = CHAR-1R0 
          LX6    3           OCT = SHIFT(OCT,3) 
          BX6    X2+X6       OCT = OCT+DIG
          SB7    B7-B1       NDG = NDG-1
          SB2    B2-B1       WCT = WCT-1
          ZR     B7,COC2     IF NDG .EQ. 0  FINISHED
          NZ     B2,COC1     IF WCT .NE. 0  LOOP
          SA1    A1+B1       I = I+1, CON = CAD(I)
          SB2    10          WCT = 10 
          EQ     COC1        LOOP 
  
*         CHECK IF LEGAL CONSTANT.
  
 COC2     BX1    X6 
          SA2    CCBB 
          BX7    X1 
          SB4    B3-1RB 
          ZR     B4,CCB3     IF CHAR .EQ. 1RB  FINISHED 
          LX3    B3,X4
          PL     X3,CCB1     IF CHAR .NE. 1RB  FATAL ERROR
          SB5    B1 
          SX3    X2-22
          MI     X3,CCB3     IF NDG .LE. 20  LEGAL CONSTANT 
          SA7    CCBI 
          EQ     CCB3        POST INFORMATIVE ERROR 
          TITLE              DISPLAY
**        CHC  -  CONVERT HOLLERITH CONSTANT. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (B1) = 1 
*                (B5) = 1 
* 
*         ACTION 1.  TEST FOR CONVERT ONLY OR CONVERT AND STORE.
*                2.  IF CONVERT ONLY, CONVERT AND RETURN WITH 
*                    CONSTANT IN X1.
*                3.  IF CONVERT AND STORE, CONVERT AND CALL OHC 
*                    FOR OUTPUT OF CONSTANT TO  COMPS FILE. 
* 
*         USES   A. -,1,2,3,-,-,6,7 
*                B. 0,1,2,3,-,5,6,7 
*                X. 0,1,2,3,4,5,6,7 
* 
*         CALLS  OUTUSE,SYMBOL,FA=WTC.
  
 DISPLAY  SA2    CCBA 
          SA1    CCBG 
          SB5    X2 
          ZR     X2,DSP1     IF CONVERT AND STORE 
  
*         CONVERT ONLY, RETURN CONSTANT IN X1.
  
          BX0    X1 
          SA1    X1          FIRST WORD = 10HXXXXXXX
          AX0    18 
          SX2    X0          N CHARACTERS 
          AX0    18 
          MX7    60-2        MASK FOR ONLY PART OF TYPE FIELD 
          SB2    X2-10
          BX3    -X7*X0      TYPE = 0 FOR H, 1 FOR L, 2 FOR R 
          PL     B2,CONVERT  EXIT IF MORE THAN 9 CHARACTERS 
          ZR     X3,CONVERT  EXIT  IF  H FORM 
  
          IX4    X2+X2
          LX2    2
          SB3    X3          TYPE 
          IX5    X4+X2       N*6
          SB6    X5 
          MX7    1
          SB7    B6-B1
          AX7    B7,X7       MASK(6*N)
          BX1    X7*X1       REMOVE TRAILING BLANKS 
          EQ     B3,B1,CONVERT  IF L FORM 
          LX1    B6,X1       RIGHT JUSTIFY
          EQ     CONVERT
  
*         CONVERT AND STORE HOLLERITH CONSTANT. 
  
 DSP1     OUTUSE HOL. 
          SA1    DSPB 
          NZ     X1,DSP2     IF  HOL. ALREADY IN SYMBOL TABLE 
          SYMBOL =8RHOL.
          SA3    =XWB.HOL    TYPE, RL AND RB
          BX7    X3+X2       TYPE = T.CGS, RL = 1, RA = 0, RB =  6
          SA7    A2 
          SX6    B1 
          SA6    DSPB 
          SB1    1
          WRITEC =XF.CMPS,DSPC,2
  
*         CALCULATE WORD COUNT AND NUMBER  OF REMAINING CHARACTERS. 
  
 DSP2     SA1    CCBG        ELIST FOR THE CON
          BX4    X1 
          AX1    18 
          SX2    X1          CHARACTER COUNT (CC) 
          SX0    10D
          IX5    X2/X0       WORD COUNT (CC/10) 
          SX0    10D
          SB2    X5          NUMBER OF FULL WORDS 
          IX6    X0*X5       10*(CC/10) 
          SX2    X1 
          IX5    X2-X6       CHARACTERS REMAINING 
          SA1    DSPB 
          ZR     X5,DSP3     NO CHARACTERS REMAINING
          SB2    B2+B1
  
 DSP3     SA3    =XHOL. 
          SB3    B2+B1
          SX7    X3+B3       INCREASE HOL. BLOCK LENGTH 
          LX3    30 
          BX6    X3+X1
          SA7    A3 
          SA6    DSPA        SAVE EXIT CONDITION
          CALL   OHC         OUTPUT CONSTANT
          WRITEC =XF.CMPS,DSPD,2   TERMINAL ZERO TO COMPS 
          SB5    1
          SA1    DSPA 
          EQ     CONVERT
  
 DSPA     BSSZ   1           30/CA,30/ORD(HOL.) 
 DSPB     BSSZ   1           ORDINAL OF HOL.
 DSPC     LIT    11CHOL. BSS 0B 
 DSPD     LIT    11C  DATA 0B 
 OHC      TITLE  OHC - OUTPUT HOLLERITH CONSTANT
**        OHC  -  OUTPUT HOLLERITH CONSTANT TO COMPS FILE.
* 
*         ENTRY  (B2) = NUMBER OF WHOLE WORDS TO BE OUTPUT. 
*                (X4) = ELIST ENTRY FOR CONSTANT. 
*                (X5) = NUMBER OF CHARACTERS IN LAST WORD .LT. 10.
* 
*         EXIT   (B1) = 1 
*                (B5) = 1 
* 
*         ACTION 1.  TRANSFER WORDS TO INTERMEDIATE BUFFER. 
*                2.  OUTPUT FULL WORDS, IF ANY, TO COMPS FILE.
*                3.  OUTPUT PARTIAL WORD, IF ANY, TO COMPS FILE.
* 
*         USES   A. -,1,2,-,-,-,6,7 
*                B. -,1,2,3,4,5,-,- 
*                X. 0,1,2,3,4,5,6,7 
* 
*         CALLS  FA=WTC 
  
 OHC      ENTRY.
          SB1    1
          BX6    X5 
          SB5    X4          B5 = FWA OF  CON 
          SA6    OHCC 
          ZR     X5,OHC1     IF NO PARTIAL WORD 
  
          AX4    36 
          MX0    60-2        MASK FOR ONLY PART OF TYPE FIELD 
          LX5    6
          BX4    -X0*X4      HOLLERITH TYPE CODE
          SA1    OHCD+X4     *  HOL  0X*  WHERE X = H, L OR R 
          SB2    B2-B1
          SA2    B5+B2       FETCH PARTIAL WORD 
          IX6    X1+X5
          BX7    X2          SAVE PARTIAL WORD IN BUFFER
          SA6    A6 
          SA7    A6+B1
  
 OHC1     ZR     B2,OHC5     IF NO FULL WORDS 
          SB2    B5+B2       B2 = LWA+1 OF FULL WORDS 
  
*         OUTPUT "  DIS   N,XXXX" STATEMENTS FOR THE FULL WORDS 
  
 OHC2     SB3    OHCB+1      FWA OF WORD BUFFER 
          SB4    OHCB+6      LWA+1 OF WORD BUFFER 
  
 OHC3     SA1    B5          MOVE WORDS TO DIS BUFFER 
          SB5    B5+B1
          BX6    X1 
          SA6    B3 
          SB3    B3+B1
          GE     B5,B2,OHC4  IF END OF CONSTANT 
          LT     B3,B4,OHC3  IF .LT. 5 WORDS TRANSFERED 
  
 OHC4     SA1    =18L  DIS   0, 
          SA2    A1+B1
          BX6    X2 
          SA6    A6+B1
          SX3    B3-OHCB-1   NUMBER OF WORDS TRANSFERED 
          LX3    6
          IX7    X1+X3
          SA7    OHCB        STORE HEADER WORD
          SX6    B5 
          SX7    B2 
          SA6    OHCA        SAVE CONSTANT LIMITS 
          SA7    A6+B1
          WRITEC =XF.CMPS,OHCB,B3-OHCB+1
          SA1    OHCA 
          SA2    OHCA+1 
          SB5    X1 
          SB2    X2          RESTORE CONSTANT LIMITS
          LT     B5,B2,OHC2  IF MORE TO GO
  
*         OUTPUT PARTIAL WORD 
  
 OHC5     SA1    OHCC 
          SB5    1
          ZR     X1,OHC      IF NO PARTIAL WORD EXISTS
          WRITEC =XF.CMPS,A1,3  PARTIAL WORD OUTPUT 
          SB5    1
          EQ     OHC
  
 OHCA     BSS    2           TO SAVE THE CONSTANT LIMITS
 OHCB     BSS    6           7 WORD BUFFER FOR DIS N,XXX STATEMENTS 
          DATA   8L 
 OHCC     DATA   28L  HOL   NX123456789 
 OHCD     DATA   10L  HOL   0H
          DATA   10L  HOL   0L
          DATA   10L  HOL   0R
*CALL FSCALE
          END 
