*
* $Id: sfrasccd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
*
* $Log: sfrasccd.F,v $
* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
* Epio
*
*
#include "epio/pilot.h"
#if defined(CERNLIB_CDC)
IDENT SFRASC
SPACE 2
*** SUBROUTINE SFRASC(SOURCE,N1,TARGET,N2,NCH)
*
* SFRASC CONVERTS A STRING OF 8-BIT ASCII CHARACTERS
* INTO A STRING OF 6-BIT DISPLAY CHARACTERS.
*
* PARAMETERS
* SOURCE SOURCE ARRAY
* N1 FIRST CHARACTER IN SOURCE TO CONVERT
* TARGET TARGET ARRAY
* N2 FIRST 6-BIT BYTE IN TARGET TO STORE IN
* NCH NO. OF CHARACTERS TO CONVERT
*
*
*
*
* H. GROTE/CERN 14 MARCH 1983
SPACE 3
ENTRY SFRASC
SPACE 1
LIST G
SPACE 2
SFRCHTR VFD 42/0LSFRASC,18/SFRASC
SFRCHA0 BSS 1
SFRCHA1 BSS 1
FIRST DATA 0
ZERO DATA 0
ARG BSS 2
USE /ASCIIC/
ITASC BSS 8
ITCDC BSS 16
USE CODE.
EXT CFRASC
SFRASC JP 400000B+*
SX6 A0
SA0 A1 A0=PARAMETER LIST ADDRESS
SA6 SFRCHA0 SAVE OLD A0
*
* CALL CFRASC FOR COMMON BLOCK INIT. FIRST TIME
*
SA1 FIRST
SB1 X1
GT B1,B0,START SKIP IF NOT FIRST TIME
SX6 1
SA6 FIRST
SA1 ZERO
SX6 A1
SA6 ARG
SA6 ARG+1B
SA1 ARG
SX6 A0
SA6 SFRCHA1
RJ CFRASC
SA1 SFRCHA1
SA0 X1
START SB1 1 CONSTANT B1=1
SB2 60 CONSTANT B2=60
SA5 A0+B1 N1 = STARTING BYTE IN SOURCE
SA5 X5
SX3 B2
SB3 3
PX0 B0,X3
NX6 B0,X0 60. IN FLOATING
BX1 X6 KEEP IN X1
SX4 1
IX0 X5-X4 N1-1
LX0 B3,X0 8*(N1-1)
PX5 B0,X0 8*(N1-1) IN FLOATING
FX4 X5/X6
UX5 B6,X4
LX6 B6,X5 8*(N1-1)/60 IN INTEGER
SB7 X6 ADDRESS OF FIRST WORD REL. TO SOURCE
DX5 X3*X6
IX4 X0-X5 STARTING BIT -1 IN WORD
SB5 X4 KEEP STARTING BIT IN SOURCE WORD
SA5 A0+B3 N2 = FIRST CH. IN TARGET
SB3 2
SA5 X5
SX4 1
IX0 X5-X4 N2-1
LX4 B3,X0
LX0 B1,X0
IX0 X0+X4 6*(N2-1)
PX5 B0,X0
FX4 X5/X1
UX5 B6,X4
LX6 B6,X5
SB2 X6 FIRST WORD IN TARGET
DX5 X3*X6
IX7 X0-X5 STARTING BIT IN TARGET
SB6 X7 STORE IN B6
SA1 A0 READ SOURCE ADDRESS
SA2 A1+B3 READ TARGET ADDRESS
SA3 A2+B3 READ ADDRESS OF NUMBER OF BYTES
SA5 X1+B7 FIRST SOURCE WORD
SA0 X2+B2 A0=TARGET WORD ADDRESS
SB2 60
SA3 X3 READ NUMBER OF BYTES
SB3 X3 B3=BYTE COUNTER
SB4 6 B4=NUMBER OF BITS PER BYTE IN TARGET
LE B3,B0,SFRCH4 RETURN IF NUMBER OF BYTES.LE.0
EQ B6,B0,SFRCH7
SA2 A0 FIRST TARGET WORD
MX7 1
SB7 B6-1
AX0 B7,X7 MASK
BX6 X0*X2 MASK FIRST TARGET WORD
EQ SFRCH8
SFRCH7 SX6 B0 CLEAR TARGET WORD IF AT LEFT BOUNDARY
SFRCH8 SB6 B2-B6 B6 = # BITS LEFT TO FILL IN TARGET WORD
SX1 77B CHARACTER MASK
SX7 177B ASCII CHARACTER MASK
SB7 8 CHARACTER LENGTH IN SOURCE
LX5 B5,X5 FIRST CHARACTER TO LEFT BOUNDARY IN X5
SPACE 2
** MAIN LOOP - ONCE PER BYTE
*
* REGISTER CONVENTIONS
* X1 DISPLAY CHARACTER MASK
* X5 SOURCE WORD
* X6 TARGET WORD
* X7 ASCII CHARACTER MASK
*
* A0 TARGET WORD ADDRESS
* A5 SOURCE WORD ADDRESS
*
* B1 1
* B2 60
* B3 BYTE COUNTER
* B4 6
* B5 BIT POSITION IN SOURCE WORD
* B6 BIT POSITION IN TARGET WORD
* B7 8
*
SPACE 2
SFRCH1 SB6 B6-B4 DECREMENT # BITS LEFT TO FILL
LE B3,B0,SFRCH3 JUMP IF LAST BYTE HAS BEEN MOVED
LX5 B7,X5 NEXT CHARACTER RIGHT ADJUSTED
SB5 B5+B7 COUNT BITS IN SOURCE WORD
BX2 X7*X5 MASK CHARACTER INTO X2 RIGHT ADJ.
GT B2,B5,SFRCH2 JUMP IF SOURCE WORD NOT COMPLETED
SB5 B5-B2 RESET SOURCE WORD BIT COUNTER
SA5 A5+B1 LOAD NEXT SOURCE WORD
EQ B5,B0,SFRCH2 JUMP IF PREVIOUS BYTE COMPLETE
SB4 4
LX5 B4,X5 LEFT ADJUST NEXT BYTE
SX0 17B MASK FOR HALF BYTE
BX2 -X0*X2
BX0 X0*X5
BX2 X2+X0 ADD TO FIRST PART OF BYTE
SB4 6
*
* FOR CONVERSION, SEE ROUTINES CTOASC, CFRASC
*
SFRCH2 SB2 X2-1
SX3 B2
SB2 3
AX3 B2,X3 (K-1)/8
SB1 X3
LX3 B2,X3
IX3 X2-X3
SX4 B4 = 6
DX3 X4*X3
SB2 X3
SA4 ITCDC+B1
LX4 B2,X4
BX2 X4*X1
SB1 1
SB2 60
LX3 B6,X2 POSITION SOURCE BYTE
SB3 B3-B1 DECREMENT BYTE COUNTER
BX6 X6+X3 ADD SOURCE BYTE TO TARGET WORD
GT B6,B0,SFRCH1 LOOP UNLESS TARGET WORD IS FULL
SA6 A0 STORE TARGET WORD
SB6 B2 RESET BIT POSITION
SA0 A0+B1 INCREMENT TARGET ADDRESS
SX6 B0 RESET X6 FOR NEXT TARGET WORD ASSEMBLY
EQ SFRCH1 LOOP
SPACE 2
** END OF LOOP - STORE INCOMPLETE TARGET WORD, IF ANY,
* AND RETURN
SPACE 2
SFRCH3 SB7 B6+B4 BIT POSITION OF LAST BYTE
EQ B7,B2,SFRCH4 RETURN IF TARGET WORD IS EMPTY
SB3 B2-B7
SB7 B3-B1
MX7 1
AX7 B7,X7 MASK FOR LAST TARGET WORD
SA2 A0 GET LAST TARGET WORD
BX3 -X7*X2
BX6 X6+X3 JOIN TARGET WORD WITH REST OF BYTE
SA6 A0 STORE LAST TARGET WORD
SFRCH4 SA4 SFRCHA0
SA0 X4 RESTORE OLD A0
EQ SFRASC RETURN
SPACE 2
END
#endif