*DECK FMCONV
          IDENT  FM$CONV
* 
* LINKAGE BETWEEN FORM AND 8-BIT SUBS FOR PERFORMING REFORMAT-TYPE
*  CONVERSIONS ON 6-BIT DATA
* 
          ENTRY  FM$CONV
* 
          LIST   -N 
          B1=1
          SST 
          SPACE  4
*#
* *   FMCONV - LINKAGE TO 8-BIT SUBROUTINES FOR CONVERSIONS 
* *   M.T. KAUFMAN
* 1DC FMCONV
* 
* DC  FUNCTION
* 
*     PROVIDE LINKAGE BETWEEN FMPARSE AND THE CONVERSION COMPONENTS 
*     OF THE 8-BIT SUBROUTINES. 
* 
* DC  ENTRY CONDITIONS
* 
*     CALLER MUST SET UP THE COM-2 COMMON BLOCK OF THE 8-BIT
*     SUBROUTINES.  FMCONV WILL USE T.T1 AND T.T2 TO DIRECT CALLS 
*     ON THE CONVERSION ROUTINES
* 
* DC  EXIT CONDITIONS 
* 
*     NONE. 
* 
* DC  ERROR CONDITIONS
* 
*     FUNCTION RETURN VALUE (GR 0) AS PROVIDED BY 8-BIT ROUTINES. 
* 
*#
          EJECT 
 TC.CNV   VFD    42/7HFM$CONV,18/*  TRACEBACK 
 CVXIT    SA1    =XT8.STAW   STATUS RETURN ADDRESS
          SA2    =XT8.SVA0   RESTORE A0 
          BX6    X5 
          SX7    B0 
          SA0    X2 
          ZR     X1,FM$CONV  NO STATUS CELL GIVEN, CONT STORE 
          SA6    X1 
* 
 FM$CONV  JP     *+1S17      ENTRY POINT
          SX7    TC.CNV      TRACEBACK INFO 
          SX2    CONV66      CONVERT TRANSFER VECTOR BASE 
          SB6    RTN.CNV     CONVERT RETURN POINT 
          EQ     =XFM$PARX   JUMP THRU VECTOR TO TEST 
* 
 RTN.CNV  SX5    B0          FLAG NORMAL RETURN 
          EQ     CVXIT
* 
          SPACE  4
**   DEFINE LINKAGE TO 8-BIT SUBROUTINES
* 
          EXT    T8.CAMB,T8.CAMV,T8.I1,T8.I2,T8.MVBT,T8.M1,T8.M2
          EXT    T8.RATC,T8.RATX,T8.RBTA,T8.RBTC,T8.RBTX,T8.RCTA,T8.RCTX
          EXT    T8.RXTA,T8.RXTC,T8.STAW,T8.SVA0,T8.SVB6
  
 ZERO.A   =      060O        X30   CONSTANTS
 ZERO.C   =      360O        XF0
 ZERO.X   =      1R0
  
 SPACE.A  =      040O        X20
 SPACE.C  =      100O        X40
 SPACE.X  =      1R 
  
 SIZE.AC  =      12 
 SIZE.X   =      6
* 
          EJECT 
**    SYMBOL  -  INVENT A NEW (UNIQUE) SYMBOL, ASSIGN TO A MICRO
* 
          MACRO  SYMBOL,L 
          LOCAL  X
 L        MICRO  1,,*_X_* 
          ENDM
          SPACE  4
**    J - MACRO TO SET UP JUMP TABLE FOR CONVERSION ACTIONS 
* 
*         J      *           (FIRST TIME) 
*         J      LOC         (SUBSEQUENT) 
* 
*         *      = SET JUMP BASE TO *-1 (THE BIT VECTOR LOCATION) 
*         LOC    = SET A 15 BIT FIELD TO LOC - (JUMP BASE)
* 
*         THE JUMP BASE IS A SYMBOL NAMED  .JBASE$
* **
 J        MACRO  LOC
 .1       IFC    EQ,/*/LOC/ 
 +        VFD    15/0 
 .JBASE$  SET    *-1
 .1       ELSE
          VFD    15/LOC-.JBASE$ 
 .1       ENDIF 
          ENDM
 LETMASK  SPACE  4,19 
** LETMASK  -  MACRO TO GENERATE BIT MASKS FOR CHARACTER STRING TESTING 
* 
*         LETMASK  LR,(LETS),(BITS),OFF 
* 
*         *LR*   = DIRECTION OF INTENDED SHIFT (L OR R) 
* 
*         *LETS* = A CHARACTER STRING, (ABC...N) WHICH DETERMINES 
*                 WHICH BITS ARE TO BE SET. IF LR=R, THE BITS ARE 
*                 SET SO THAT A RIGHT SHIFT OF *X*-OFF BITS WILL
*                 PLACE A 1 BIT IN BIT 0 IF *X* IS ONE OF THE 
*                 CHARACTERS IN THE STRING. IF LR=L, THE BITS ARE 
*                 SET TO PLACE A 1 BIT IN BIT 59 AFTER A LEFT SHIFT.
* 
*         *BITS* = A LIST OF VALUES. EACH VALUE WILL BE USED TO 
*                 SET A BIT.  THIS IS LIKE *LETS* EXCEPT THAT THE 
*                 GIVEN VALUE IS USED, RATHER THAN *1R_VALUE*.
* 
*         *OFF*  = AN OFFSET TO BE APPLIED WHEN SETTING BITS. 
* **
 LETMASK  MACRO  LR,LETS,BITS,OFF 
          LOCAL  A,B,C,D,E,F,G,H,I
 A        SET    0
 B        MICRO  1,,^_LETS_^
 C        OCTMIC ,10D 
 D        OCTMIC ,10D 
 F        SET    OFF 0
 G        MICCNT B
 H        MICRO  1,,/-F+/ 
 .1       IFC    NE,/LR/R/
 H        MICRO  1,,/59D+F-/
 .1       IFC    NE,/LR/L/
          ERR    L_R SPECIFICATION MISSING OR INCORRECT 
 .1       ENDIF 
 .1       DUP    G
 A        SET    A+1
 B        MICRO  A,1,^_LETS_^ 
          LETMSK. C,D,E,I,("H"1R"B")
 .1       ENDD
          IRP    BITS 
          LETMSK. C,D,E,I,("H"BITS) 
          IRP 
          DATA   "D""C"O
 LETMASK  ENDM
          SPACE  2
**    LETMSK.  -  AUXILIARY MACRO FOR LETMASK 
 LETMSK.  MACRO  C,D,E,I,V
 I        SET    V
          IFLT   I,60,1 
          IFLT   I,0,2
 E        DECMIC I,3
          ERR    BIT OUT OF WORD AT "E" 
 .2       IFLE   I,29D
 E        DECMIC I,2
 C        OCTMIC 1S"E"+"C"B,10D 
 .2       ELSE
 E        DECMIC I-30D,2
 D        OCTMIC 1S"E"+"D"B,10D 
 .2       ENDIF 
 LETMSK.  ENDM
* 
          EJECT 
          TITLE  CON66 - REFORMAT CONVERSIONS 
* 
*  JUMP VECTOR FOR CONVERSION 
* 
 CONV66   LETMASK R,(ABCDEINSUXZ)  LEGAL T1 TYPES 
          J      *
          ECHO   1,P=(Z,X,U,S,N,I,E,D,C,B,A)
          J      CON66._P 
          ECHO   4,P=(Z,X,U,S,N,I,E,D,C,B,A)
 CON66._P  LETMASK R,(ABCDEINSUXZ),00B  LEGAL T2 TYPES
          J      *
          ECHO   1,Q=(Z,X,U,S,N,I,E,D,C,B,A,0)
          J      CON66._P_Q 
* 
          SPACE  4
* 
*  STRING TYPE CONVERSIONS
* 
          SPACE  1
* 
 CON66.B0 SA5    T8.M1       B-0 DEFAULTS TO B-B
          BX6    X5 
          SA6    T8.M2
* 
 CON66.BB SB5    C66.1       B-B
          EQ     =XT8.GSBX
 C66.1    SB5    C66.2
          EQ     T8.GDB 
 C66.2    SA2    T8.I2       CALL MVBITS
          SA3    T8.SVB6
          SA1    T8.I1
          BX7    X2 
          SB6    X3 
          AX2    36 
          EQ     T8.MVBT
* 
          SPACE  2
* 
 CON66.BA SB5    C66.3       B-A
          EQ     T8.GSBX
 C66.3    SB5    C66.4
          EQ     T8.GDC 
 C66.4    SX5    T8.RBTA
          SX6    ZERO.A 
          SX3    SIZE.AC
          EQ     C66.9
* 
 CON66.BC SB5    C66.5       B-C
          EQ     T8.GSBX
 C66.5    SB5    C66.6
          EQ     =XT8.GDC 
 C66.6    SX5    T8.RBTC
          SX6    ZERO.C 
          SX3    SIZE.AC
          EQ     C66.9
* 
 CON66.BX SB5    C66.7       B-X
          EQ     T8.GSBX
 C66.7    SB5    C66.8
          EQ     =XT8.GD6 
 C66.8    SX5    T8.RBTX
          SX6    ZERO.X 
          SX3    SIZE.X 
* 
 C66.9    SA2    T8.I2       SET UP AND CALL CNA..MV
          SA4    T8.SVB6
          SA1    T8.I1
          BX7    X2 
          SB5    X4 
          SX2    B1 
          EQ     T8.CAMV
* 
          SPACE  2
* 
 CON66.AB SB7    ZERO.A      A-B
 C66.10   SB5    C66.11 
          EQ     =XT8.GSCX
 C66.11   SB5    C66.12 
          EQ     =XT8.GDB 
 C66.12   SX5    B7          MOVE TO BIT FIELD
          SB7    SIZE.AC
          EQ     T8.CAMB
* 
 CON66.CB SB7    ZERO.C      C-B
          EQ     C66.10 
* 
 CON66.XB SB5    C66.13      X-B
          EQ     =XT8.GS6X
 C66.13   SB5    C66.14 
          EQ     =XT8.GDB 
 C66.14   SX5    ZERO.X 
          SB7    SIZE.X 
          EQ     T8.CAMB
* 
          SPACE  2
* 
 CON66.A0 SA5    T8.M1       A-DEFAULT
          BX7    X5 
          SA7    T8.M2
* 
 CON66.AA SB7    SPACE.A     A-A
 C66.15   SB5    C66.16 
          EQ     T8.GSCX
 C66.16   SB5    C66.17 
          EQ     =XT8.GDC 
 C66.17   SX2    SIZE.AC
          SX5    B0 
 C66.18   SX3    SIZE.AC
          SX6    B7 
 C66.19   SA1    T8.I2
          SA4    T8.SVB6
          BX7    X1 
          SB5    X4 
          SA1    T8.I1
          EQ     T8.CAMV
* 
 CON66.C0 SA5    T8.M1       C-DEFAULT
          BX7    X5 
          SA7    T8.M2
* 
 CON66.CC SB7    SPACE.C     C-C
          EQ     C66.15 
* 
 CON66.AC SB5    C66.20      A-C
          EQ     T8.GSCX
 C66.20   SB5    C66.21 
          EQ     =XT8.GDC 
 C66.21   SX5    T8.RATC
          SX2    SIZE.AC
          SB7    SPACE.C
          EQ     C66.18 
* 
 CON66.CA SB5    C66.22      C-A
          EQ     T8.GSCX
 C66.22   SB5    C66.23 
          EQ     =XT8.GDC 
 C66.23   SX5    T8.RCTA
          SX2    SIZE.AC
          SB7    SPACE.A
          EQ     C66.18 
* 
 CON66.XA SB5    C66.24      X-A
          EQ     T8.GS6X
 C66.24   SB5    C66.25 
          EQ     =XT8.GDC 
 C66.25   SX5    T8.RXTA
          SX2    SIZE.X 
          SB7    SPACE.A
          EQ     C66.18 
* 
 CON66.XC SB5    C66.26      X-C
          EQ     T8.GS6X
 C66.26   SB5    C66.27 
          EQ     =XT8.GDC 
 C66.27   SX5    T8.RXTC
          SX2    SIZE.X 
          SB7    SPACE.C
          EQ     C66.18 
* 
          SPACE  1
* 
 CON66.AX SB7    T8.RATX     A-X
 C66.28   SB5    C66.29 
          EQ     T8.GSCX
 C66.29   SB5    C66.30 
          EQ     =XT8.GD6 
 C66.30   SX2    SIZE.AC
          SX5    B7 
 C66.31   SX3    SIZE.X 
          SX6    SPACE.X
          EQ     C66.19 
* 
 CON66.CX SB7    T8.RCTX     C-X
          EQ     C66.28 
* 
 CON66.X0 SA5    T8.M1       X-DEFAULT
          BX7    X5 
          SA7    T8.M2
* 
 CON66.XX SB5    C66.32      X-X
          EQ     T8.GS6X
 C66.32   SB5    C66.33 
          EQ     =XT8.GD6 
 C66.33   SX2    SIZE.X 
          SX5    B0 
          EQ     C66.31 
* 
          SPACE  4
* 
* NUMERIC MODE CONVERSIONS
* 
 .A       ECHO   ,P=(A,B,C,X),R=(C,B,C,6) 
 .B       ECHO   ,Q=(I,U,E,D,S,N,Z),U=(E,E,E,D,6,6,6) 
 XXX      SYMBOL
 YYY      SYMBOL
 CON66._P_Q  SB5   "XXX"     P-Q
          EQ     =XT8.GS_R
 "XXX"    SB5    "YYY"
          EQ     =XT8.GD_U
 "YYY"    SB5    C66.._Q
          SA1    T8.I1
          EQ     =XT8.C6_P
          SPACE  1
 .B       ENDD
 .A       ENDD
* 
          SPACE  2
* 
 .A       ECHO   ,P=(I,U,E,D,S,N,Z),R=(E,E,E,D,6,6,6) 
.B        ECHO   ,Q=(I,U,E,D,S,N,Z,A,B,C,X),Y=(E,E,E,D,6,6,6,C,B,C,6) 
 XXX      SYMBOL
 YYY      SYMBOL
 CON66._P_Q  SB5   "XXX"     P-Q
          EQ     =XT8.GS_R
 "XXX"    SB5    "YYY"
          EQ     =XT8.GD_Y
 "YYY"    SB5    C66.._Q
          SA1    T8.I1
          EQ     =XT8.C6_P
          SPACE  1
 .B       ENDD
 .A       ENDD
* 
          SPACE  2
* 
*  DEFAULT CASES
* 
 .A       ECHO   ,P=(I,U,E,D) 
 CON66._P_0  EQU  CON66._P_P
 .A       ENDD
* 
 .A       ECHO   ,P=(S,N,Z) 
 CON66._P_0  SA5  T8.M1 
          BX7    X5 
          SA7    T8.M2
          EQ     CON66._P_P 
          SPACE  1
 .A       ENDD
* 
          SPACE  2
* 
 .A       ECHO   ,P=(I,U,E,D,S,N,Z,A,B,C,X) 
 C66.._P  SA2    T8.SVB6
          SA1    T8.I2
          SB5    X2 
          EQ     =XT8.C6X_P 
          SPACE  1
 .A       ENDD
* 
          SPACE  2
* 
          END 
