Google
 
Trailing-Edge - PDP-10 Archives - bb-j939f-bm - bliss/cvt10.sno
There are 7 other files named cvt10.sno in the archive. Click here to see a list.
*	SITBOL PROGRAM TO CONVERT BLISS-10 TO BLISS-36C
*
* REVISION HISTORY
*
*	11-JULY-77	AL	%REMAINDING BUG SHOULD BE 'REMAINING'
*
*	11-JULY-77	AL	'ABS' ISN'T A BLISS-10 SPECIFIC FUNCTION
*
*	12-JULY-77	PD	NOVALUE REPLACED BY %INFORM.
*
*	18-JULY-77	DL	ADD BLISS10_REGS, SIX12->NULL NOT DEBUG
*
*	20-JULY-77	DL	CODED <BIND STRUC VAR = NOT PLIT, ... ;>
*				CHANGES TO PATTERNS, FASTER NOW
*				MODULE HEADER SAYS LANGUAGE, B10_REGS
*
*	21-JULY-77	DL	ADDED STACKLOCAL
*				FIXED GLOBAL BIND AND ROUTINE
*				RESTRUCTURED #NUMBER TRANSFORMATION
*
*	22-JULY-77	DL	FIXED INFINITE LOOP, ADDED CODE TO
*				NOT PUT %STRING ON %CHAR UNLESS NEEDED.
*				NSET -> SET EVEN ON SELECT LINE.
*
*	29-AUG-77	DL	TIGHTENED UP CASE AND SELECT SO THEY
*				CAN BETTER HANDLE PROGRAM LABELS IN
*				TERMS OF INDENTING AND IN NOT GETTING
*				THEM CONFUSED WITH CASE & SELECT LABELS.
*
*	8-MAR-78	DL	FIXED MACROS SO MACRO ON THE SAME LINE
*				AS ONE OF SEVERAL DEFS WORKS RIGHT.
*
*	9-MAR-78	DL	ENABLED NDECS TO HAVE INITIAL ATTRIBUTES
*
*	19-MAY-78	DL	GIVE A WARNING ABOUT STRUCTURE DECLARATIONS
*
*	22-MAY-78	DL	PUT PARENS AROUND PLIT ITEM IF NEEDED
*
*	24-MAY-78	DL	HACK TO FIX SELECT LABELS ON QUOTED STRINGS
*
* END OF REVISION HISTORY
*
*

	&DUMP = 1
	&ANCHOR = 1
	&TRIM = 1

	CVTVERSION = '24(5)'

*		PATTERNS TO MATCH AND SAVE THE END-OF-LINE CHARS
*		LINES ARE READ IN WITH EOL CHARS ON THEM.
	LF = ASCII(12); CR = ASCII(15)
	FF = ASCII(14); TABCH = ASCII(11)
	TCC = SPAN(CR LF FF) . EOL
	CRLF = CR LF

*		OUTPUT FUNCTIONS AND STORAGE MECHANISMS
*	QUEUES AND STACKS ARE MAINTAINED BY THE FUNCTIONS BELOW

	DEFINE('QUEUE(QNAME,QVAL)CURRENT')
	DEFINE('UNQUEUE(QNAME)')
	DEFINE('PUSH(SNAME,SVAL)')
	DEFINE('POP(SNAME)')
	DATA('CELL(CAR,CDR)')

*	INITIAL AND FINAL CALLS TO THESE STORAGE MECHANISMS CREATE
*	AND DELETE THEM RESPECTIVELY.  CELL IS THE BASIC DATA ITEM


*		SOME DEFINITIONS:
	LC = 'abcdefghijklmnopqrstuvwxyz'
	UC = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
	BLANKS = ' ' TABCH
	DIGITS = '0123456789'
	NUMBER = SPAN(DIGITS)
*		'SPANBLK' MATCHES WHITE SPACES BUT MAY NOT BE NULL
	SPANBLK = SPAN(BLANKS)
	SPANBLKN = SPANBLK ! NULL
	ALL.BLANK = POS(0) SPANBLK RPOS(0)
	SPACE8 = DUPL(' ',8)
	SPACE4 = DUPL(' ',4)
	DIMEN = '[' ARB ']' ! NULL

*		BLISS-10 IDENTIFIER IS 'NAME'
*		'COMPLX.NAME' MATCHES NAME1:NAME2:...:NAMEN
	NAME = ANY(UC) SPAN(UC DIGITS) ! ANY(UC)
	COMPLX.NAME = ANY(UC) BREAK(',;[=')
	SPEC.CHAR = '.%$'
	QUOTES = ANY('"' "'") . QUOCH
	EXTN.CH = SPAN(UC LC SPEC.CHAR)
	SP.IDENT = EXTN.CH SPAN(UC LC DIGITS SPEC.CHAR) ! EXTN.CH
*		'SP.IDENT' MATCHES BLISS-10 IDENTIFIERS THAT FOLLOW '?'

*		FOR FINDING <NAME>[...]<...>. ONCE FOUND, THIS
*		PHRASE IS CHANGED TO (<NAME>[...])<...>  (SEE DOC)
	POINTNAME = (NAME '[' BREAK(']') ']') . STRCREF
+	    ('<' BREAK('>') '>') . FLDREF

*		TRANSFORMATION PATTERNS

*		TO CONVERT CONTROL CHARS ?M -> %CHAR(13)
	DEFINE('FORMQ(CTRLCH)')
	NEXT.CH = LEN(1) . NEXTCH REM . LINE
	QMARKS = BREAK('?') . QS1 '?' LEN(1) . CTRLCH REM . QSTR

*		TO MAP "X" -> %C'X' AND TO WARN ON LONGER STRINGS
	SINGLE.CHAR = LEN(1) RPOS(0) ! '""' RPOS(0)
+			! '?' LEN(1) . CTRLCH RPOS(0) ! RPOS(0)


*		KEYWORD MATCHING AND SUBSTITUTIONS
*		(SEE FORMAT AT BOTTOM)
	KEYWORD = 'ASCII' ! 'ASCIZ' ! 'RADIX50'
+	    ! 'VREG' ! 'SIXBIT' ! 'STRUCTURE'
+	    ! 'SCAN' ! 'REPLACE' ! 'COPY' ! 'INCP'
+	    ! 'FIRSTONE' ! 'OFFSET' ! 'NOVALUE'
+	    ! 'EXIT' ! 'GLOBALLY' ! 'INDEXES' ! 'NAMES'
	LTERM = NOTANY(UC DIGITS)
	NUM.KW = 17
	WARNING.MES = '%(**WARNING**BLISS10**)%'
	RTERM = TABLE(NUM.KW)
	NEW.KW = TABLE(NUM.KW)
	NEW.KW<'NOVALUE'> = "%INFORM('NOVALUE')"
		RTERM<'NOVALUE'> = LTERM
	NEW.KW<'ASCII'> = '%ASCII';	RTERM<'ASCII'> = LTERM
	NEW.KW<'ASCIZ'> = '%ASCIZ';	RTERM<'ASCIZ'> = LTERM
	NEW.KW<'RADIX50'> = '%RAD50_10';	RTERM<'RADIX50'> = LTERM
	NEW.KW<'SIXBIT'> = '%SIXBIT';	RTERM<'SIXBIT'> = LTERM
	NEW.KW<'VREG'> = 'VREG' WARNING.MES
	    RTERM<'VREG'> = LTERM ! RPOS(0)
	NEW.KW<'SCAN'> = WARNING.MES 'SCAN'
	    RTERM<'SCAN'> = ANY('NI') LTERM
	NEW.KW<'REPLACE'> = WARNING.MES 'REPLACE'
	  RTERM<'REPLACE'> = ANY('NI') LTERM
	NEW.KW<'COPY'> = WARNING.MES 'COPY'
	    RTERM<'COPY'> = ANY('NI') ANY('NI') LTERM
	NEW.KW<'INCP'> = WARNING.MES 'INCP'
	    RTERM<'INCP'> = LTERM
	NEW.KW<'FIRSTONE'> = WARNING.MES 'FIRSTONE'
	    RTERM<'FIRSTONE'> = LTERM
	NEW.KW<'OFFSET'> = WARNING.MES 'OFFSET'
	    RTERM<'OFFSET'> = LTERM
	NEW.KW<'EXIT'> = WARNING.MES 'EXIT'
	    RTERM<'EXIT'> = ('CASE' ! 'COMPOUND' ! 'COMP' ! 'CONDIT'
+		! 'COND' ! 'SELECT' ! 'SET' ! NULL) (LTERM ! RPOS(0))
	NEW.KW<'GLOBALLY'> = WARNING.MES 'GLOBALLY'
	  RTERM<'GLOBALLY'> = LTERM ! RPOS(0)
	NEW.KW<'INDEXES'> = WARNING.MES 'INDEXES'
	  RTERM<'INDEXES'> = LTERM ! RPOS(0)
	NEW.KW<'NAMES'> = WARNING.MES 'NAMES'
	    RTERM<'NAMES'> = LTERM ! RPOS(0)
	NEW.KW<'STRUCTURE'> =
+	     'STRUCTURE %(**WARNING**MUST BE HAND TRANSLATED**)%'
	  RTERM<'STRUCTURE'> = LTERM ! RPOS(0)

*		PATTERN TO SEE IF THERE IS A KEYWORD ON THIS LINE
	KEYSCAN = (POS(0) ! ARB LTERM) . PART1
+			KEYWORD $ KW  (*RTERM<KW> ! RPOS(0)) . PART2

*	<LTERM><KEYWORD><RTERM> TRANSFORMS TO
*		<LTERM><NEW KEYWORD><RTERM>

	OCTSCAN = (BREAK('#') ! NULL) . PART1 '#' NUMBER . PART2

*	DECLARATION PATTERNS AND FORMAT DEFINITIONS

*	NORMAL DECLARATION REVERSAL PATTERNS
*	REVDCL IS THE MAIN MULTILINE DECLARATION REVERSER
*	GRDDCL IS THE RECURSIVE KERNAL OF REVDCL (FOR 1 LINE)
	DEFINE('REVDCL(SEGMENT)')
	DEFINE('GRDDCL(SECTION,START.SP)NEWDEC')

*		FOR SPLITTING UP 'COMPLX.NAME'S
	SPLIT.NAME = NAME . ANAME  (':' ! RPOS(0))

*		SOME NDECS
	DECNAME = 'OWN' ! 'GLOBAL' ! 'LOCAL' ! 'EXTERNAL'
+		! 'REGISTER' ! 'MAP' ! 'STACKLOCAL'

	DECLARATION = (POS(0) ! ARB LTERM) . PREDEC
+	    DECNAME . CURRENT.DEC (SPANBLK REM  ! RPOS(0)) . POSTDEC

*		PATTERN TO DECOMPOSE NDECS
	INIT.PAT = ( '=' $ TRY2.INIT SPANBLKN ( '(' (BREAK('(')
+	    ABORT ! (BREAK(')') . INIT ')') ! ABORT)
+	    ! NULL BREAK(',;') . INIT
+	    ! ABORT ))	! NULL . INIT

	GTR.PAT = ((( SPANBLK ! POS(0)) 'GLOBAL ROUTINE') . PART1
+		SPANBLK NAME . PART2
+		SPANBLK (NAME BREAK('=')) . PART3)

	PARSE.SEC1 = (SPANBLK ! POS(0)) . PRETERM
+		(NAME . ATTRB SPANBLK ! NULL . ATTRB) 
+		COMPLX.NAME . CNAME  SPANBLKN DIMEN . BOUNDS
+		SPANBLKN
	PARSE.SEC2 = SPANBLKN ANY(',;') . TERMINATOR  REM . POSTTERM

	PARSE.DEC = PARSE.SEC1 INIT.PAT PARSE.SEC2

	PART.PARSE = PARSE.SEC1 '=' SPANBLKN (('('
+	    REM) . POSTTERM ! NULL . POSTTERM RPOS(0))


*		REQUIRE FILE QUOTING (IF NOT QUOTED)
	DEFINE('REQDCL(SEGMENT)')
	REQDEC = (POS(0) ! ARB LTERM) . PREDEC  'REQUIRE'
+	    SPANBLK . POSTDEC  ("'" ABORT ! ARB . FILENAME)
+	    (';' REM) . TERMINATOR



*		ROUTINE PRODUCES NEXT LOGICAL TAB AFTER TPSTR
	DEFINE('TABPOS(TPSTR)NUM.SP')

*		ROUTINE MAKES TABS .GTE. TPSTR, IE <TAB> -> <TAB>
	DEFINE('TABTO(TPSTR)NUM.SP')

*		TABS TO NEXT <LT> AFTER TPSTR, BUT PRESERVES TPSTR
	DEFINE('TABWITH(TPSTR)NUM.SP')

*		ROUTINE PRODUCES EXACT TABS AND SPACES FROM MTSTR
	DEFINE('MAKTAB(MTSTR)NUM.SP')

*		ROUTINE TO FIGURE OUT ACTUAL POSITION
	DEFINE('FIGR.SP(BASE)CHAR1')



*		BIND VECTOR PLITS EXCHANGING
	DEFINE('BNDDCL(SEGMENT)')
	DEFINE('BNDPLT(SECTION)')

*		PATTERN TO RECOGNIZE PLITS
	PLTDEC = (SPANBLK ! POS(0)) . PRETERM
+	    (NAME . ATTRB SPANBLK ! NULL . ATTRB)  NAME . VNAME
+	    (SPANBLKN '=' (SPANBLKN
+	    ('PLIT' ! 'UPLIT' !  NULL) . PLIT.TYPE) REM) . POSTTERM

	BNDDEC = (POS(0) ! ARB LTERM) . PREDEC 'BIND'
+	    (SPANBLK REM ! RPOS(0)) . POSTDEC

*		PATTERNS TO FIND THE END OF BIND DECLARATIONS
	PLTEND = (BREAK(';') ! NULL) . PRESTOP  ';' REM . POSTSTOP

	OTHREND = ANY(',;') . STOPPER (SPANBLKN RPOS(0)) . POSTSTOP




*	PUT PARENS ON PLITS: PLIT 'ABC' -> PLIT ('ABC')
*	ABORT IF ALREADY HAS PARENS

	NOPAREN.PLIT =
+	    ((ARB LTERM ! NULL) ('PLIT' ! 'UPLIT') SPANBLKN) . PLITPART 
+	    ('(' ABORT ! ARB RPOS(0)) . OTHERPART

*	PATTERNS AND DEFS FOR MACHOPS AND MODULE HEADERS, SUMMARY

*		MACHOPS -> MACROS WITH BUILTIN MACHOP
	DEFINE('MHOPDCL(SEGMENT)')
	DEFINE('MACMSH(SECTION,START.SP)NEWDEC')
	MSHDEC = (POS(0) ! ARB LTERM) . PREDEC 'MACHOP'
+	    (SPANBLK REM ! RPOS(0)) . POSTDEC
	MHOP.SPLIT = (SPANBLK ! POS(0)) NAME . MSH.NAME
+	    SPANBLKN '=' SPANBLKN BREAK(',;') . MSH.CODE
+	    LEN(1) . TERMINATOR  REM . POSTTERM


*	MODULE HEADER GETS %BLISS36(BLISS10_REG %QUOTE,)
*	MODULE HEADER SIX12 -> NULL

	DEFINE('MODDCL(SEGMENT)')

	MODDEC = (BREAK('(') '(') . PREDEC  ARB . MIDDEC
+	    (')' SPANBLKN '=' SPANBLKN ('BEGIN' ! NULL)
+	    SPANBLKN RPOS(0)) . POSTDEC

	MH.SIX12 = SPANBLKN 'TIMER' SPANBLKN '=' SPANBLKN
+	    'EXTERNAL(SIX12)' SPANBLKN

	MH.INFO = '%BLISS36(BLISS10_REGS %QUOTE,)' CRLF
+	    TABCH 'LANGUAGE(%BLISS36(BLISS36)' CRLF
+	    TABCH '%BLISS32(BLISS32)' CRLF
+	    TABCH '%BLISS16(BLISS16))'



*	MACRO $ -> %QUOTE %QUOTE ... %, MACRO.DEPTH - 1 %QUOTE'S

	MACRO.TERM = (POS(0) NULL ! LEN(1)) . CH1 '$'
+	    ((BREAK(',;') ! NULL) ANY(',;') . CH2
+	    ! SPANBLKN NULL . CH2 RPOS(0))

	MACRO.NEW = (POS(0) ! LTERM) 'MACRO' BREAK('$')

*	NOTE: KLUDGE SO THAT ONE LINE MACROS WORK RIGHT
*	BEFORE DECLARATION MATCHING A CHECK IS DONE TO
*	SEE IF A MACRO IS COMING, SO MACRO DEPTH CAN
*	BE TEMP. INCREMENTED VIA MXTRA
	MXTRA = 0




*	SUMMARY OF DECLARATIONS

	ALL.TRNS = 'GLOBAL ROUTINE' ! 'GLOBAL BIND'
+	    ! DECNAME ! 'REQUIRE' ! 'BIND' ! 'SWITCHES' ! 'FORWARD'
+	    ! 'MACHOP' ! 'CASE' ! 'SELECT' ! 'MODULE' ! 'MACRO'

	KNOWN.TRNS = (POS(0) ! ARB LTERM)
+		ALL.TRNS . DECKEY  (SPANBLK ! RPOS(0))

*	ABOVE ARE THE KEY PATTERNS TO THE OPERATION OF CVT10

*	TABLE OF TRANSFORMS

	TRNTAB = TABLE(16)
	TRNTAB<'GLOBAL'> = 'NDEC';	TRNTAB<'OWN'> = 'NDEC'
	TRNTAB<'LOCAL'> = 'NDEC';	TRNTAB<'EXTERNAL'> = 'NDEC'
	TRNTAB<'MAP'> = 'NDEC';		TRNTAB<'FORWARD'> = 'FDEC'
	TRNTAB<'REGISTER'> = 'NDEC';	TRNTAB<'REQUIRE'> = 'RDEC'
	TRNTAB<'BIND'> = 'BDEC';	TRNTAB<'SWITCHES'> = 'SDEC'
	TRNTAB<'MACHOP'> = 'MDEC';	TRNTAB<'CASE'> = 'CASE'
	TRNTAB<'SELECT'> = 'SEL';	TRNTAB<'MODULE'> = 'MOD'
	TRNTAB<'MACRO'> = 'MCRO';	TRNTAB<'STACKLOCAL'> = 'NDEC'
	TRNTAB<'GLOBAL BIND'> = 'BDEC'
	TRNTAB<'GLOBAL ROUTINE'> = 'GTR'

*	NDECS ARE NORMAL DECLARATIONS, NOP IS NO-OPERATION TO DO


*	PATTERNS TO CONTROL THE CVTCOM AND CVTTEXT FEATURES(SEE DOC)
	CVTCOMP =  SPANBLKN ('CVTCOM' ! 'cvtcom')
	CVTTEXTP = SPANBLKN ('CVTTEXT' ! 'cvttext')
	MOCTVCP = SPANBLKN '!' SPANBLKN ('MOCTVC' ! 'moctvc')
	TXETTVCP = SPANBLKN '!' SPANBLKN ('TXETTVC' ! 'txettvc')

*	PATTERNS FOR CASE STATEMENTS AND SELECTS
	STOP.SET = ARB . PRESTOP ((NULL . SPEC.TERM ANY('();') . STOPPER REM . POSTSTOP)
+	    ! ((POS(0) ! LTERM) . SPEC.TERM
+	    ('BEGIN' ! 'END' ! 'CASE' ! 'OF' ! 'SET' ! 'TES') . STOPPER
+	    (LTERM REM ! RPOS(0)) . POSTSTOP))

	TOP.BOUND = '<$$$' NUMBER . CASE.NUM '$$$>'
	HIGH.RANGE = ARRAY('64')
	JUST.COMMENT = (SPANBLK ! POS(0)) '!'

	DEFINE('CASEXP(SEGMENT)BUILD.STR')
	DEFINE('PREFIX(SEGMENT)PRESTUFF,POSTSTUFF')
	DEFINE('UNFIX(SEGMENT)PRESTUFF,POSTSTUFF')

*		    CASEXP WILL STACK A CASE ENVIRONMENT IF ANOTHER
*		    CASE IS ENCOUNTERED.  THE STACKS ARE:
*		    PC.:PAREN.COUNT, EC.:EXP.COUNT, CC.:CASE.NO
*		    SEE ALSO THE CASE TRANSFORM SECTION



*	PATTERNS AND DEFS FOR SELECTS

	SEL.STOP.SET = (POS(0) ! ARB) . PRESTOP
+	    (((SPANBLK '[' BREAK(']') ']' ABORT ! ARB) . MIDSTOP
+	      ':' . STOPPER REM . POSTSTOP)
+	  ! ((LTERM ! POS(0)) . MIDSTOP
+	    ('SELECT' ! 'NSET' ! 'TESN') . STOPPER
+	    ((LTERM ! RPOS(0)) REM) . POSTSTOP))
	SEL.COLON = ((SPANBLKN ! POS(0)) . PRESTOP
+	  (BREAK(' ' TABCH ':' CRLF) ! NULL) . EXPTERM
+	  SPANBLKN (':' ! CRLF ABORT)) . MIDSTOP REM . POSTSTOP
*	DON'T LOOK BEYOND A CRLF SO WON'T SEE DECLARE ATTRIBUTES ':'

	BADCODE.NSET = (ARB LTERM) . PRESTOP 'NSET' REM . POSTSTOP

	DEFINE('SELEXP(SEGMENT)')
	DEFINE('AT.END(BASE,ENDER)CHAR.CNT')

*	HACK PATTERN TO TRY TO PUT [] AROUND QUOTED STRINGS IN NEEDED.
*	OPERATES ON THE OUTSTR BEING BUILT AFTER!!! OUTSEC IS CALLED.
	HACK.EXPSET = SPANBLKN REM . EXPTERM

*		MAIN ENVIRONMENTS FOR PATTERN MATCHING
	N = BREAK("!%?" "'" '"')  . STRING  LEN(1) . BRKCH  REM . LINE
	C = ARB . STRING  RPOS(0)
	P = BREAK('%') . STRING  LEN(1) . BRKCH    REM . LINE
	Q1 = BREAK("'") . STRING  LEN(1) . BRKCH  REM . LINE
	Q2 = BREAK('"') . STRING  LEN(1) . BRKCH  REM . LINE
	L = SP.IDENT . STRING REM . LINE

*		MATCH=>LEAVE STATE NOW
*		N:NORMAL, C:COMMENT, P:PERCENT COMMENT
*		Q:QUOTED STRING (POSSIBLE DOUBLE QUOTES)
*		L:LITERAL NAME LIKE ?J..DAT --> %NAME('J..DAT')
*		ENV.SX: SUCCEEDED IN LEAVING STATE X
*		ENV.FX: FAILED TO LEAVE STATE X
*		ENV.EX: ENTERED STATE X WITH NULL LINE LEFT

	STATAB = TABLE(5)
	STATAB<'%'> = 'P'; STATAB<"'"> = 'Q1'
	STATAB<'?'> = 'L'; STATAB<'!'> = 'C'
	STATAB<'"'> = 'Q2'

	BRKTAB = TABLE(5)
	BRKTAB<'%'> = '%('; BRKTAB<"'"> = ''
	BRKTAB<'!'> = '!';  BRKTAB<'?'> = ''
	BRKTAB<'"'> = ''


*	SPECIAL ELIMINATION OF <0,0> AND <0,36>
	KILL.POINTY = '<0,' ('0' ! '36') '>'

*		SPECIAL DEBUGGING AIDS

					:(FILBEG)
	OUTPUT(.TTYOUT,'TTY:',)
	INPUT(.TTYIN,'TTY:',)
	CK.LBL = 'MTV' ! 'MTL' ! 'LOOK' ! 'NODEBUG'

CK.	TTYOUT = 'COMMANDS:   MTV(MATCH VARIABLE), MTL(MATCH LITERAL),'
+		' LOOK, NODEBUG'
CK	TTYOUT = 'COMMAND>'
	COMMAND = TTYIN 	:F(XEND)
	COMMAND CK.LBL		:S($('CK.' COMMAND))F(CK.)
CK.MTV	TTYOUT = 'VARIBLE>'
	STRG = TTYIN
	STRG = $STRG		:(CK.MT)
CK.MTL	TTYOUT = 'LITERAL>'
	STRG = TTYIN
CK.MT	TTYOUT = 'PATTERN>'
	PAT0 = TTYIN
	STRG $PAT0	:S(CK)
	TTYOUT = 'FAILED' :(CK)
CK.LOOK	TTYOUT = 'VARIBLE>'
	TTYOUT = '/' $TTYIN '/'	:(CK)
CK.NODEBUG				:(FILGET)

*	SETUP I/O FILES, EXIT TO ALLOW CORE IMAGE TO BE SAVED

FILBEG	COMPILED = EQ(COMPILED,0) 1		:F(FILCMP)
	EXIT(0)

FILCMP	OUTPUT(.TTYOUT,'TTY:',)
	INPUT(.TTYIN,'TTY:',)
FILGET	TTYOUT = 'INPUT FILE NAMES SEPARATED BY SPACES'
	FIN.NAMES = TTYIN			:F(XXXEND)
	FIN.NAMES = IDENT(FIN.NAMES) 'TTY:'
	TTYOUT = 'OUTPUT FILE NAMES'
	FOUT.NAMES = TTYIN			:F(XXXEND)
	FOUT.NAMES = IDENT(FOUT.NAMES) 'TTY:'

	FILES.IN = ARRAY(16)
	FILES.OUT = ARRAY(16)
	SPLIT.FILE = (RPOS(0) ABORT) ! ((SPANBLK ! POS(0))
+	    ARB . FNAME (SPANBLK ! RPOS(0)))
	FILE.NUM = 0
	NUM.FILES = 0

FILBRK	FIN.NAMES SPLIT.FILE = ''		:F(FILDON)
	FILE(FNAME)				:F(FILPUNT)
	NUM.FILES = NUM.FILES + 1
	FILES.IN<NUM.FILES> = FNAME		:(FILBRK)
FILPUNT	TTYOUT = '%CVT UNKNOWN FILE ' FNAME	:(FILGET)

FILDON	FOUT.NAMES SPLIT.FILE = ''		:F(FILDONE)
	FILE.NUM = FILE.NUM + 1
	FILES.OUT<FILE.NUM> = FNAME		:(FILDON)

FILDONE	FILE.NUM = 0				:(MAIN)

*		MAIN PROGRAM ACTS LIKE A FINITE-STATE MACHINE

MAIN	STATE = 'N'
	ENV = N
	QSTR = ''
	EQYET = '';	BNDYET = '';	LABEL = ''
	HOLD = 0;	CASE.NO = 0;	ABS.CASE.NO = 0
	SEL.DEPTH = 0;	CASE.DEPTH = 0;	MACRO.DEPTH = 0
	CVTCOM = '';	CVTTEXT = '';	CLOSE.PLIT = ''
	QUOCH = ''

	FILE.NUM = FILE.NUM + 1
	OUTPUT(.FILEOUT,FILES.OUT<FILE.NUM>,'T')
	INPUT(.FILEIN,FILES.IN<FILE.NUM>,'T')

	FILEOUT = '!' DUPL(TABCH,2) 'BLISS-10 TO BLISS-36C CONVERSION  '
+		'(VERSION ' CVTVERSION ') ' DATE()  CRLF  CRLF

RDLOOP	LINE = FILEIN		:F(XEND)
	&ANCHOR = 0
	LINE TCC = ''
	&ANCHOR = 1
	OUTSTR = ''
	EQ(CASE.DEPTH,0)			:S(CTLOOP)
	IDENT(LINE)				:S(CTLOOP)
	LINE = PREFIX(LINE)
CTLOOP	STRING = LINE
	BRKCH = ''
	LINE ENV		:S($('ENV.S' STATE))F($('ENV.F' STATE))

ENV.SN	IDENT(LINE)		:S($('ENV.E' STATAB<BRKCH>))
	STATE = STATAB<BRKCH>
	BRKCH QUOTES
ENV.OK	BRKCH = BRKTAB<BRKCH>		:(ENV.N)
ENV.FN	LINE = ''
ENV.N	STRING = REPLACE(STRING,'_@' LC,'=.' UC)
	&ANCHOR = 0
	REPCH = ''
	STRING MACRO.NEW		:F(FIXPER)
	MXTRA = 1
	MACRO.1LINE = 'TRUE'
FIXPER	STRING MACRO.TERM		:F(DELPNT)
	REPCH = LNE(CH1,' ') ' '
	REPCH = REPCH DUPL('%QUOTE ',
+	    MACRO.DEPTH - 1 + MXTRA) '%'		:S(FIXP0)
	REPCH = '% %(**WARNING**LOOSE DOLLAR SIGN NOW %)%'
FIXP0	STRING '$' = REPCH
	DIFFER(MACRO.1LINE)			:S(FIXPER)
	MACRO.DEPTH = LEQ(CH2,';') MACRO.DEPTH - 1	:(FIXPER)
DELPNT	MXTRA = 0
DEL00	STRING KILL.POINTY = ''				:S(DEL00)
POINTY	STRING POINTNAME = '(' STRCREF ')' FLDREF	:S(POINTY)
	&ANCHOR = 1
*	CHANGE PLIT 'FOOBAR' INTO PLIT ('FOOBAR')
	IDENT(QUOCH)				:S(DOKEYS)
	STRING NOPAREN.PLIT			:F(DOKEYS)
	STRING = PLITPART '(' OTHERPART
	CLOSE.PLIT = 'TRUE'
DOKEYS	NEW.STRING = ''
NEWKWD	STRING KEYSCAN = ''			:F(KEYEND)
	NEW.STRING = NEW.STRING PART1
+			NEW.KW<KW> PART2	:(NEWKWD)
KEYEND	STRING = NEW.STRING STRING
	NEW.STRING = ''
OCTKWD	STRING OCTSCAN = ''		:F(OCTEND)
	NEW.STRING = NEW.STRING PART1 "%O'" PART2 "'"	:(OCTKWD)
OCTEND	STRING = NEW.STRING STRING

*	TRANSFORM ROUTINE CALLS

	DIFFER(TRANS.TYPE)		:S($('T.' TRANS.TYPE))
	STRING KNOWN.TRNS		:F(NO.DO)
	TRANS.TYPE = TRNTAB<DECKEY>	:($('T.' TRANS.TYPE))



NO.DO	STRING = NE(CASE.DEPTH,0) CASEXP(STRING)
	STRING = NE(SEL.DEPTH,0) SELEXP(STRING)	:(OUTSEC)

T.NDEC	STRING = REVDCL(STRING)			:(NO.DO)

T.RDEC	STRING = REQDCL(STRING)			:(NO.DO)

T.FDEC	STRING ((SPANBLK ! POS(0)) 'FORWARD') . PREFRWD = PREFRWD ' ROUTINE'
	TRANS.TYPE = ''			:(NO.DO)

T.BDEC	STRING = BNDDCL(STRING)		:(NO.DO)

T.SDEC	LINE = ''
	STRING = ''
	TRANS.TYPE = ''
	EOL = LEQ(EOL,CRLF)  ''		:(NO.DO)
*		DELETE ALL SWITCHES, LEAVES A <FF> BUT KILLS <CRLF>


T.MDEC	STRING = MHOPDCL(STRING)			:(NO.DO)

T.MOD	TRANS.TYPE = ''
	STRING = MODDCL(STRING)				:(NO.DO)

T.CASE	TRANS.TYPE = ''
	STRING = CASEXP(STRING)
	STRING = NE(SEL.DEPTH,0) SELEXP(STRING)		:(OUTSEC)

T.SEL	TRANS.TYPE = ''
	STRING = NE(CASE.DEPTH,0) CASEXP(STRING)
	STRING = SELEXP(STRING)				:(OUTSEC)

T.MCRO	TRANS.TYPE = ''
	MACRO.1LINE = DIFFER(MACRO.1LINE) ''		:F(NORMAC)
	LEQ(CH2,';')					:S(NO.DO)
NORMAC	MACRO.DEPTH = MACRO.DEPTH + 1			:(NO.DO)

T.NOP	TRANS.TYPE = ''					:(NO.DO)

T.GTR	TRANS.TYPE = ''
	STRING GTR.PAT = PART1 ' ' PART3 ' :' TABCH PART2 ' ' :(NO.DO)

*		HANDLING OF STRINGS AND COMMENTS


ENV.EC				:(ENV.OK)
ENV.FC
ENV.SC	LINE = ''
	DIFFER(CVTCOM CVTTEXT)	:S($('COM.' CVTCOM CVTTEXT))
*		SEE IF THIS COMMENT SAYS TO ENTER COM OR TEXT READING
	STRING CVTCOMP		:F(COM1)
	CVTCOM = 'COM'		:(OUTSEC)
COM1	STRING CVTTEXTP		:F(COM2)
	CVTTEXT = 'TXT'		:(OUTSEC)
COM2	STATE = 'N'		:(OUTSEC)

*		IN COM MODE SO COMMENT EACH LINE UNTIL MOCTVC
COM.COM	STRING MOCTVCP		:F(COMC)
	CVTCOM = ''
	STATE = 'N'		:(OUTSEC)
COMC	STRING = '!' TABCH STRING	:(OUTSEC)

*		IN TEXT MODE SO REMOVE LEADING '!' UNTIL TXETTVC
COM.TXT	STRING TXETTVCP		:F(COMT)
	CVTTEXT = ''
	STATE = 'N'		:(OUTSEC)
COMT	STRING (SPANBLKN . PART1 '!') = PART1	:(OUTSEC)


ENV.EP	STATE = 'P'		:(ENV.OK)
ENV.SP	STATE = 'N'
	BRKCH = ')%'				:(OUTSEC)
ENV.FP	LINE = ''				:(OUTSEC)

ENV.EQ1
ENV.EQ2	CLOSE.PLIT = ''
	QUOCH = ''
	BRKCH = "' !**WARNING** DANGLING QUOTE"	:(ENV.N)

ENV.SQ1
ENV.SQ2	LINE NEXT.CH				:F(TRANSQ)
	LINE = LNE(NEXTCH,QUOCH) NEXTCH LINE	:S(TRANSQ)
	QSTR = QSTR STRING QUOCH QUOCH		:(CTLOOP)

TRANSQ	QSTR = QSTR STRING
	STATE = 'N'
	LEQ(QUOCH,"'")				:S(SKIPDQ)
	QSTR SINGLE.CHAR			:F(WARNDQ)
	STRING = LEQ(QSTR,'""') "%C'" '"' "'"	:S(QDONE2)
	STRING = LEQ(QSTR,"'") "%C''''"		:S(QDONE2)
	STRING = IDENT(QSTR) "''"		:S(QDONE2)
		LEQ(QSTR,'?' CTRLCH)		:F(NORMSC)
	STRING = LEQ(CTRLCH,'0') '0 %(NULL CHAR)%'	:S(QDONE2)
	STRING = LEQ(CTRLCH,'1') '127 %(DELETE CHAR)%'	:S(QDONE2)
	STRING = LEQ(CTRLCH,'?') "%C'?'"		:S(QDONE2)
	CHCODE = -1
	FORMQ(CTRLCH)
	STRING = EQ(CHCODE,-1) "%C'" CTRLCH
+		"' -64 %(**WARNING**QUESTIONMARK)%"	:S(QDONE2)
	STRING = CHCODE ' %(CTRL-' CTRLCH ')%'		:(QDONE2)
NORMSC	STRING = "%C'" QSTR "'"				:(QDONE2)
WARNDQ	STRING = '"' QSTR '" %(**WARNING**DOUBLE QUOTES)%'    :(QDONE2)

SKIPDQ	CTRLCH = ''
	NQSTR = ''
RMOVQM	QS1 = ''
	QSTR QMARKS				:F(QDONE)
	NQSTR = DIFFER(NQSTR) NQSTR ','
	QS1 = DIFFER(QS1) "'" QS1 "',"
	NQSTR = NQSTR QS1 FORMQ(CTRLCH)		:(RMOVQM)

FORMQ	FORMQ = LEQ(CTRLCH,'?') "'?'"	:S(RETURN)
	FORMQ = LEQ(CTRLCH,'1') '%CHAR(127)'	:S(RETURN)
	&ANCHOR = 0
	('0' UC) (@CHCODE CTRLCH)		:F(FRMBAD)
	&ANCHOR = 1
	FORMQ = '%CHAR(' CHCODE ')'		:(RETURN)
FRMBAD	FORMQ = "%CHAR(%C('" CTRLCH "')-64)"
+		"%(**WARNING**QUESTIONMARK)%"	:(RETURN)

QDONE	NQSTR = ?(DIFFER(QSTR) DIFFER(NQSTR)) NQSTR ",'" QSTR "'"
	STRING = IDENT(NQSTR) "'" QSTR "'"	:S(QDONE2)
	&ANCHOR = 0
	NQSTR ','				:S(QDONE1)
	STRING = NQSTR				:(QDONE2)
*	    CHECKING FOR LONE %CHAR'C', DON'T PUT %STRING AROUND IT
QDONE1	STRING = '%STRING(' NQSTR ')'
QDONE2	&ANCHOR = 1
	QUOCH = ''
	QSTR = ''
	BRKCH = IDENT(CLOSE.PLIT) ''		:S(OUTSEC)
	CLOSE.PLIT = ''
	BRKCH = ')'				:(OUTSEC)
ENV.FQ1
ENV.FQ2	LINE = ''
	QUOCH = ''
	STRING = "'" STRING
	STATE = 'N'
	BRKCH = IDENT(CLOSE.PLIT) '  !**WARNING**MISSING QUOTE'	:S(OUTSEC)
	CLOSE.PLIT = ''
	BRKCH = ') !**WARNING**MISSING QUOTE'	:(OUTSEC)

ENV.SD	STATE = DIFFER(LINE) 'Q'		:S(OUTSEC)F(ENV.FQ)
ENV.FD	STATE = 'N'
	STRING = ''				:(OUTSEC)

ENV.EL	BRKCH = "?  !**WARNING**ILLEGAL USE OF '?'"	:(ENV.N)
ENV.SL	STRING = "%NAME('" STRING "')"
	STATE = 'N'				:(OUTSEC)
ENV.FL	STRING = " %(**WARNING**ILLEGAL '?' NAME)% ?"
	STATE = 'N'				:(OUTSEC)

*	ROUTINES FOR TRANSLATING NORMAL DECLARATIONS

REVDCL	IDENT(SEGMENT)		:S(FRETURN)
	DIFFER(CURRENT.DEC)			:S(CTRDCL)
	SEGMENT DECLARATION			:S(SETDCL)
	TRANS.TYPE = ''				:(FRETURN)
SETDCL	JUST.TABS = TABPOS(PREDEC)
	NL.TABS = CRLF JUST.TABS
	SP.PRENAME = JUST.TABS
	SP.PRENAME = DIFFER(POSTDEC) NL.TABS
	REVDCL = PREDEC CURRENT.DEC
+		GRDDCL(POSTDEC,SP.PRENAME)	:S(RETURN)F(FRETURN)

CTRDCL	INHIBIT.SELLBL = 'TRUE'
	REVDCL = GRDDCL(SEGMENT,JUST.TABS)	:S(RETURN)F(FRETURN)


GRDDCL	GRDDCL = IDENT(SECTION) ''		:S(RETURN)
	SECTION ALL.BLANK			:F(CTGRD)
	GRDDCL = SECTION			:(RETURN)
CTGRD	TRY2.INIT = ''
	TERMINATOR = ''
	SECTION PARSE.DEC			:S(GRDINI)
	TRANS.TYPE = ''
	CURRENT.DEC = ''
	IDENT(TRY2.INIT)			:S(FRETURN)
	SECTION PART.PARSE			:F(FRETURN)
	INIT = DIFFER(POSTTERM) 'INITIAL ' POSTTERM	:S(GRD)
	INIT = 'INITIAL'			:(GRD)
GRDINI	IDENT(INIT)				:S(GRD)
	INIT = 'INITIAL(' INIT ')'
GRD	ATTRB = DIFFER(ATTRB) ':' TABCH ATTRB BOUNDS		:S(GRDA)
	ATTRB = DIFFER(BOUNDS) ':' TABCH 'VECTOR' BOUNDS	:S(GRDA)
	ATTRB = DIFFER(INIT) ':' TABCH INIT	:(UNANC)
GRDA	ATTRB = DIFFER(INIT) ATTRB ' ' INIT
UNANC	&ANCHOR = 0
RMVBLK	CNAME SPANBLK = ''			:S(RMVBLK)
	&ANCHOR = 1
	NEWDEC = ''
GRD1	CNAME SPLIT.NAME = ''			:F(GRD2)
	NEWDEC = DIFFER(NEWDEC) NEWDEC ',' NL.TABS
	NEWDEC = NEWDEC ANAME ATTRB		:(GRD1)
GRD2	NEWDEC = START.SP NEWDEC
	GRDDCL = IDENT(TERMINATOR) NEWDEC	:S(RETURN)
	LEQ(',',TERMINATOR)			:F(GRD3)
	GRDDCL = NEWDEC ',' GRDDCL(POSTTERM,NL.TABS)	:F(FRETURN)S(RETURN)
GRD3	CURRENT.DEC = ''
	TRANS.TYPE = ''
	POSTTERM ALL.BLANK ! RPOS(0)			:S(GRD4)
	POSTTERM SPANBLK = ''
	POSTTERM = CRLF MAKTAB(PREDEC) POSTTERM
GRD4	GRDDCL = NEWDEC ';' POSTTERM		:(RETURN)




*	REQUIRE DECLARATION TRANSFORM

REQDCL	SEGMENT REQDEC			:S(REQ0)
	TRANS.TYPE = ''			:(FRETURN)
REQ0	POSTDEC = POSTDEC "'" FILENAME "'" TERMINATOR
	REQDCL = PREDEC 'REQUIRE' POSTDEC
	TRANS.TYPE = ''				:(RETURN)

*	TAB FORMATTING FUNCTIONS

*	TABPOS POSITIONS AT THE NEXT LOGICAL TAB STOP AFTER TPSTR
TABPOS	NUM.SP = FIGR.SP(TPSTR)
	TABPOS = DUPL(TABCH,NUM.SP / 8)
	NUM.SP = NUM.SP - (8 * (NUM.SP / 8))
	TABPOS = LT(NUM.SP,4) TABPOS SPACE4	:S(RETURN)
	TABPOS = TABCH TABPOS			:(RETURN)

*	<TAB> -> <TAB> BUT <TAB>X -> <TAB><LTAB>
TABTO	NUM.SP = FIGR.SP(TPSTR)
	TABTO = DUPL(TABCH,NUM.SP / 8)
	NUM.SP = NUM.SP - (8 * (NUM.SP / 8))
	TABTO = EQ(NUM.SP,0) TABTO		:S(RETURN)
	TABTO = LE(NUM.SP,4) TABTO SPACE4	:S(RETURN)
	TABTO = TABCH TABTO			:(RETURN)


*	MAKE AN EXACT NUMBER OF TABS AND SPACES
MAKTAB	NUM.SP = FIGR.SP(MTSTR)
	MAKTAB = DUPL(TABCH,NUM.SP / 8)
+	    DUPL(' ',NUM.SP - 8 * (NUM.SP / 8))	:(RETURN)


*	AT.END FITS ENDER INTO BASE WITHOUT CHANGING THE SIZE OF BASE
*	XXXXXXEEEEXXX: -> XXXXXXX[EEEE]:  FOR LABELING SELECTS
AT.END	CHAR.CNT = FIGR.SP(BASE)
	AT.END = GT(SIZE(ENDER), CHAR.CNT) ENDER	:S(RETURN)
	BASE = MAKTAB(DUPL(' ',CHAR.CNT - SIZE(ENDER)))
	AT.END = BASE ENDER			:(RETURN)


*	FIGR.SP IS USED TO FIND THE TAB POSITIONS
FIGR.SP	FIGR.SP = IDENT(BASE) 0			:S(RETURN)
FIGR0	BASE LEN(1) . CHAR1 = ''		:F(RETURN)
	FIGR.SP = LNE(CHAR1, TABCH) FIGR.SP + 1	:S(FIGR0)
	FIGR.SP = 8 + 8 * (FIGR.SP / 8)		:(FIGR0)


*	PREFIX PUTS EXTRA TABS ON ADDITIONAL INDEXING TEXT, CASE LABELS
PREFIX	IDENT(SEGMENT)					:S(FRETURN)
	PREFIX = ''
	SEGMENT SPANBLK . PRESTUFF REM . POSTSTUFF	:F(PXLBL)
	PRESTUFF = TABTO(PRESTUFF)
PX.FOOL	SEGMENT JUST.COMMENT			:S(PX.NLBL)
	IDENT(LABEL)				:S(PX.NLBL)
	IDENT(POSTSTUFF)			:S(PX.NLBL)
	LABEL = ''
	PREFIX = PREFIX TABWITH(DUPL(TABCH,CASE.DEPTH - 1) PRESTUFF
+	    '[' EXP.COUNT ']:') POSTSTUFF 	:S(RETURN)F(FRETURN)
PX.NLBL	PREFIX = PREFIX TABTO(DUPL(TABCH,CASE.DEPTH) PRESTUFF)
+	    POSTSTUFF				:S(RETURN)F(FRETURN)
PXLBL	SEGMENT (BREAK(':') LEN(1) SPANBLKN) . PRESTUFF
+	    REM . POSTSTUFF	:F(PXFLBL)
	PREFIX = PRESTUFF
	PRESTUFF = ''				:(PX.FOOL)
PXFLBL	PRESTUFF = ''
	POSTSTUFF = SEGMENT	:(PX.FOOL)
*	IF A PROGRAM LABEL EXISTS TRY TO INDENT AFTER IT
*	THIS METHOD MAY NOT WORK FOR ALL CASES
*	IF LABEL IS TRUE A CASE LABEL IS PUT ON THE FIRST NON-NULL AND
*	NON-ALL BLANK LINE, COMMENTS SHOULDN'T GET LABELED, ONLY BODY.



UNFIX	IDENT(SEGMENT)				:S(FRETURN)
	SEGMENT SPANBLK . PRESTUFF REM . POSTSTUFF	:F(UNF0)
	PRESTUFF = TABTO(PRESTUFF)
	PRESTUFF = TABTO(DUPL(' ',FIGR.SP(PRESTUFF) - 8))
	UNFIX = PRESTUFF POSTSTUFF		:(RETURN)
UNF0	UNFIX = SEGMENT				:(RETURN)
*	??UNF0 SHOULD NEVER HAPPEN??


*	FORMATS THE CASE LABEL
TABWITH	NUM.SP = FIGR.SP(TPSTR)
	NUM.SP = NUM.SP - 8 * (NUM.SP / 8)
	TABWITH = LT(NUM.SP,4) TPSTR DUPL(' ',4 - NUM.SP) :S(RETURN)
	TABWITH = TPSTR TABCH				  :(RETURN)
*	MAKE SURE THE LABEL TAKES UP EXACTLY 8 SPACES,
*	BY EITHER APPENDING A PHYSICAL TAB, OR A FEW SPACES

*	BIND PLIT AND UPLIT TRANSFORMS, MODULE HEADER

*	CHANGES THE POSITION OF <BIND STRC VAR = PLIT (...)>
*	TO <BIND VAR = PLIT (...) :STRUC> WITH DEFAULT <:VECTOR>
*	RESTRICTION: <VAR STRUC = PLIT> MUST BE ON THE SAME LINE
*	CHANGES <BIND STRUC VAR = OTHER> TO <BIND VAR = OTHER: STRUC>
*	<<<NOTE>>> AS WRITTEN, ONLY BIND ...; <SEMICOLON> IS CONVERTED

BNDDCL	DIFFER(BNDYET)			:S(CTBND)
	SEGMENT BNDDEC			:F(BADBND)
	BNDYET = 'TRUE'
	BNDDCL = PREDEC 'BIND' BNDPLT(POSTDEC)	:S(RETURN)F(FRETURN)
BADBND	TRANS.TYPE = ''				:(FRETURN)
CTBND	BNDDCL = BNDPLT(SEGMENT)		:S(RETURN)F(FRETURN)


BNDPLT	BNDPLT = IDENT(SECTION) ''		:S(RETURN)
	SECTION ALL.BLANK			:F(BNDP1)
	BNDPLT = SECTION			:(RETURN)
BNDP1	DIFFER(EQYET)				:S(CTPLT)
	SECTION PLTDEC				:S(SETBND)
	TRANS.TYPE = ''
	BNDYET = ''				:(FRETURN)

SETBND	IDENT(PLIT.TYPE)			:S(BNDOTHR)
	EQYET = 'TRUE'
*	ONLY ONE PLIT PER BIND, BUT MANY REGULAR DECS ARE OKAY
	ATTRB = IDENT(ATTRB) 'VECTOR'
	ATTRB = TABCH ':' ATTRB			:(BNDMORE)
BNDOTHR	ATTRB = DIFFER(ATTRB) ':' TABCH ATTRB
	&ANCHOR = 0
	POSTTERM OTHREND = ATTRB STOPPER POSTSTOP	:S(BNDOTR0)
	&ANCHOR = 1
	TRANS.TYPE = ''; BNDYET = ''		:(FRETURN)
*	PUNTING DUE TO NO DELIMITER FOUND AFTER BIND DEC 
BNDOTR0	&ANCHOR = 1
	BNDPLT = PRETERM VNAME POSTTERM
	LEQ(STOPPER,',')			:S(RETURN)
	TRANS.TYPE = ''; BNDYET = ''		:(RETURN)
BNDMORE	BNDPLT = PRETERM VNAME BNDPLT(POSTTERM)	:(RETURN)

CTPLT	SECTION PLTEND				:S(ENDPLT)
	BNDPLT = SECTION			:(RETURN)
ENDPLT	TRANS.TYPE = ''; BNDYET = ''; EQYET = ''
	POSTSTOP ALL.BLANK ! RPOS(0)			:S(ENDPLT0)
	POSTSTOP SPANBLK = ''
	POSTSTOP = CRLF MAKTAB(PREDEC) POSTSTOP
ENDPLT0	INHIBIT.SELLBL = 'TRUE'
	BNDPLT = PRESTOP ATTRB ';' POSTSTOP		:(RETURN)



*	MODULE HEADER TRANSFORM, SIX12 -> NULL, INSERT BLISS10_REGS
*	PUT A %QUOTE , IFF MORE OPTIONS FOLLOW

MODDCL	SEGMENT MODDEC					:F(MODMTY)
	&ANCHOR = 0
	MIDDEC MH.SIX12 ',' = ''	:S(MODCNT)
	MIDDEC ',' MH.SIX12 = ''	:S(MODCNT)
	MIDDEC MH.SIX12 = ''
MODCNT	&ANCHOR = 1
	MIDDEC ALL.BLANK = ''
	MIDDEC = IDENT(MIDDEC) MH.INFO			:S(MODDONE)
	MIDDEC SPANBLK = ''
	MIDDEC = MH.INFO ', ' MIDDEC			:(MODDONE)
MODMTY	&ANCHOR = 0
	SEGMENT '=' = '(' MH.INFO ') ='
	&ANCHOR = 1
	MODDCL = SEGMENT				:(RETURN)
MODDONE	MODDCL = PREDEC MIDDEC POSTDEC			:(RETURN)

*		ROUTINES FOR TRANSLATING MACHOPS INTO MACROS

MHOPDCL	IDENT(SEGMENT)		:S(FRETURN)
	DIFFER(MSHYET)			:S(CTMSH)
	SEGMENT MSHDEC			:S(SETMSH)
	TRANS.TYPE = ''				:(FRETURN)
SETMSH	MACDEF = TABTO(PREDEC)
	JUST.TABS = TABPOS(MACDEF)
	MACDEF = MACDEF 'MACRO'
	NL.TABS = CRLF JUST.TABS
	SP.PRENAME = JUST.TABS
	SP.PRENAME = DIFFER(POSTDEC) NL.TABS
	PERQUO = ''
	PERQUO = DUPL('%QUOTE ',MACRO.DEPTH)
	MSHYET = 'TRUE'
	MHOPDCL = PREDEC 'BUILTIN MACHOP;' CRLF CRLF MACDEF
+	    MACMSH(POSTDEC,SP.PRENAME)	:S(RETURN)F(FRETURN)

CTMSH	MHOPDCL = MACMSH(SEGMENT,JUST.TABS)		:S(RETURN)F(FRETURN)


MACMSH	MACMSH = IDENT(SECTION) ''		:S(RETURN)
	SECTION ALL.BLANK			:F(CTMMSH)
	MACMSH = SECTION			:(RETURN)
CTMMSH	SECTION MHOP.SPLIT		:S(MSH0)
	TRANS.TYPE = ''
	MSHYET = ''			:(FRETURN)
MSH0	NEWDEC = MSH.NAME '[] = MACHOP(' MSH.CODE ', '
+	    PERQUO '%REMAINING) ' PERQUO '%'
	NEWDEC = START.SP NEWDEC
	LEQ(';',TERMINATOR)			:S(MSH1)
	MACMSH = NEWDEC ',' MACMSH(POSTTERM,NL.TABS)	:F(FRETURN)S(RETURN)
MSH1	MSHYET = ''
	TRANS.TYPE = ''
	POSTTERM ALL.BLANK ! RPOS(0)			:S(MSH2)
	POSTTERM SPANBLK = ''
	POSTTERM = CRLF MAKTAB(PREDEC) POSTTERM
MSH2	MACMSH = NEWDEC ';' POSTTERM		:(RETURN)

*	CASE STATEMENT TRANSFORM, PUTTING IN LABELS AND LO-HI BOUNDS

*	EXP.COUNT IS THE CURRENT LABEL
*	CASE.DEPTH IS THE NUMBER OF CASES PENDING

CASEXP	IDENT(SEGMENT)			:S(FRETURN)
CASPAT	SEGMENT STOP.SET		:F(CASNS)
	PRESTOP = PRESTOP SPEC.TERM
	LEQ(STOPPER,';')		:S(CS.SEMI)F($('CS.' STOPPER))
CASTILL	BUILD.STR = BUILD.STR PRESTOP STOPPER
	SEGMENT = POSTSTOP			:(CASPAT)
CASNS	CASEXP = BUILD.STR SEGMENT		:(RETURN)

CS.BEGIN
CS.(	PAREN.COUNT = PAREN.COUNT + 1		:(CASTILL)

CS.END
CS.)	PAREN.COUNT = PAREN.COUNT - 1		:(CASTILL)

CS.SEMI	GT(PAREN.COUNT,0)			:S(CASTILL)
	EXP.COUNT = EXP.COUNT + 1
	LABEL = IDENT(LABEL) 'TRUE'		:S(CASTILL)
	LABEL = ''
	TTYOUT = '%CVT ATTEMPT TO PUT MORE THAN ONE LABEL PER LINE'
	QUEUE('OUTPUTQ','%(***WARNING***MULTIPLE LABELS)%' CRLF) :(CASTILL)
*		SIGNAL THE END OF ONE CASE EXPR

*		UNBALANCED CASE MEANS A TES OCCURED UNEXPECTEDLY
*		TES POPS THE STACKS RESTORING OLD CASE ENVIRONMENT
CS.TES	STOPPER = GT(PAREN.COUNT,0) 'TES %(WARNING: UNBALANCED CASE)%'
	HIGH.RANGE<CASE.NO> = EXP.COUNT
	CASE.DEPTH = CASE.DEPTH - 1
	HOLD = HOLD - 1
	(BUILD.STR PRESTOP) (ALL.BLANK ! RPOS(0))	:S(CSTES0)
	STOPPER = TABTO(BUILD.STR PRESTOP) STOPPER
	STOPPER = CRLF UNFIX(STOPPER)			:(CSTES1)
CSTES0	BUILD.STR = DIFFER(BUILD.STR) UNFIX(BUILD.STR)	:S(CSTES1)
	PRESTOP = UNFIX(PRESTOP)
*		UNDENT TES AND SET(SEE BELOW) FROM THE TEXT
CSTES1	SEGMENT = EQ(CASE.DEPTH,0)  PRESTOP STOPPER POSTSTOP  :S(CASNS)
	PAREN.COUNT = POP('PC.STACK')
	EXP.COUNT = POP('EC.STACK')
	CASE.NO = POP('CN.STACK')		:(CASTILL)

CS.CASE	EQ(CASE.DEPTH,0)			:S(NEWCAS)
	PUSH('CN.STACK',CASE.NO)
	PUSH('PC.STACK',PAREN.COUNT)
	PUSH('EC.STACK',EXP.COUNT)
NEWCAS	SEEN.OF = ''
	ABS.CASE.NO = ABS.CASE.NO + 1
	CASE.NO = ABS.CASE.NO
	PAREN.COUNT = 0
	EXP.COUNT = 0
	CASE.DEPTH = CASE.DEPTH + 1
	HOLD = HOLD + 1					:(CASTILL)

CS.OF	STOPPER = IDENT(SEEN.OF)
+	    'FROM 0 TO <$$$' CASE.NO '$$$> OF'		:F(CASTILL)
	SEEN.OF = 'TRUE'				:(CASTILL)

CS.SET	LABEL = IDENT(LABEL) 'TRUE'			:S(CSSET0)
	LABEL = ''
	TTYOUT = '%CVT ATTEMPT TO PUT OUT MORE THAN ONE LABEL PER LINE'
	QUEUE('OUTPUTQ','%(***WARNING***MULTIPLE LABELS)%' CRLF)
CSSET0	BUILD.STR = DIFFER(BUILD.STR) UNFIX(BUILD.STR)	:S(CASTILL)
	PRESTOP = UNFIX(PRESTOP)			:(CASTILL)

*	SELECT TRANSFORM ENCLOSES EXPRESSIONS IN []
*	SELECT MAY BE NESTED, CASES AND SELECTS MAY BE ENTWINED

SELEXP	IDENT(SEGMENT)			:S(FRETURN)
	SEGMENT SEL.STOP.SET		:F(FRETURN)S($('SL.' STOPPER))

SL.TESN	SEL.DEPTH = SEL.DEPTH - 1
	SELEXP = PRESTOP MIDSTOP 'TES' POSTSTOP		:(RETURN)

SL.NSET	SELEXP = PRESTOP MIDSTOP 'SET' POSTSTOP		:(RETURN)

SL.SELECT
	SEL.DEPTH = SEL.DEPTH + 1
	SEGMENT BADCODE.NSET			:F(FRETURN)
	SELEXP = PRESTOP 'SET' POSTSTOP		:(RETURN)

SL.:	DIFFER(INHIBIT.SELLBL)			:S(FRETURN)
	SEGMENT SEL.COLON			:F(FRETURN)
	DIFFER(PRESTOP)			:S(SL.LBL)
	EXPTERM NAME RPOS(0)		:S(FRETURN)
SL.LBL	DIFFER(EXPTERM)				:S(NOHACK)
*	HACK TO PUT [] AROUND QUOTED STRINGS BY LOOKING AT PREVIOUS OUTSTR
	OUTSTR HACK.EXPSET			:F(NOHACK)
	MIDSTOP = OUTSTR MIDSTOP
	OUTSTR = ''
NOHACK	SELEXP = AT.END(MIDSTOP,'[' EXPTERM ']:') POSTSTOP    :(RETURN)
*	WATCH OUT FOR PROGRAM LABELS: <POS(0)> <NAME> :



*	NOTE:   SINCE THE CASE TRANSFORM LOOKS FOR TES AND SET IT MUST
*	BE DONE BEFORE THE SELECT TRANSFORM CHANGES SETN AND TESN INTO
*	SET AND TES.

*	NOTE:	SINCE THE SELECT TRANSFORM LOOKS FOR COLONS IT MUST
*	BE DONE AFTER THE NORMAL DECLARATION TRANSFORMS HAVE CHANGED
*	COMPLEX NAMES INTO A LIST OF NAMES.
*	LOCAL X:Y:Z;	->	LOCAL X,Y,Z;   (WITH NEWLINES ALSO)
*	INHIBIT.SELLBL INHIBITS SELECT FROM SEEING NEW CASE LABELS
*	IN THE EVENT THAT A CASE IS INSIDE OF A SELECT, SEE ALSO
*	SEL.STOP.SET PREVENTS A SELECT STATEMENT FROM BEING
*	MISSED IF IT FOLLOWS A NEW CASE LABEL. SELECT INSIDE CASE.

*	NOTE:	OTHER FACTORS REQUIRE THAT CHARACTER TRANSFORMS
*	AND KEYWORD TRANSFORMS PRECEED DECLARATION TRANSFORMS.
*		***  OVER ALL ORDERING REQUIRED  ***
*	CHARACTER -> KEYWORD -> DECLARATION -> CASE -> SELECT

*	I/O SECTION, STACKS AND QUEUES

OUTSEC	OUTSTR = OUTSTR STRING BRKCH
	ENV = $STATE
	OUTSTR = IDENT(LINE) OUTSTR EOL		:F(CTLOOP)
	INHIBIT.SELLBL = ''
	GT(HOLD,0) QUEUE('OUTPUTQ',OUTSTR)	:S(RDLOOP)
OUTPQ	OFFQ = UNQUEUE('OUTPUTQ')		:F(OUTDONE)
	&ANCHOR = 0
	OFFQ TOP.BOUND = HIGH.RANGE<CASE.NUM>	:S(OUTPQ0)
	OFFQ TOP.BOUND = '%(***WARNING***HIGH BOUND?)%'	:F(OUTPQ0)
	TTYOUT = '%CVT UNABLE TO FIND CASE HIGH BOUND'
OUTPQ0	&ANCHOR = 1
	FILEOUT = OFFQ				:(OUTPQ)
OUTDONE	FILEOUT = OUTSTR			:(RDLOOP)

*	HOLD > 0 QUEUE THE OUTPUT LINES
*	HOLD = 0 UNQUEUE ALL QUEUED LINES AND THEN OUTPUT CURRENT LINE



*	QUEUE AND STACK DATA ABSTRACTIONS

QUEUE	CURRENT = QNAME '.CURRENT'
	IDENT($CURRENT)				:S(MAKEQ)
	CDR($CURRENT) = CELL(QVAL)
	$CURRENT = CDR($CURRENT)		:(RETURN)
MAKEQ	$QNAME = CELL(QVAL)
	$CURRENT = $QNAME			:(RETURN)


UNQUEUE	$(QNAME '.CURRENT') = IDENT($QNAME)  ''		:S(FRETURN)
	UNQUEUE = CAR($QNAME)
	$QNAME = CDR($QNAME)		:(RETURN)


PUSH	$SNAME = CELL(SVAL,$SNAME)	:(RETURN)

POP	IDENT($SNAME)			:S(FRETURN)
	POP = CAR($SNAME)
	$SNAME = CDR($SNAME)		:(RETURN)


*	END OF PROGRAM

XEND	EQ(HOLD,0)		:S(XXEND)
	TTYOUT = '%CVT INTERNAL TROUBLES, OUTPUT REMAINS QUEUED.'
	FILEOUT = FF '! CVT ******FORCED UNQUEUING FOLLOWS******' CRLF
	HOLD = 0			:(OUTPQ)
XXEND	ENDFILE(FILES.OUT<FILE.NUM>)
	ENDFILE(FILES.IN<FILE.NUM>)
	TTYOUT = EQ(FILE.NUM,NUM.FILES) CRLF CRLF    :F(MAIN)S(FILGET)
XXXEND	&DUMP = 0

END