**********************************************************************
* Name:		TB
* Desc:		Tabify source code string
* Stack:	( $ --> $' )
**********************************************************************
ASSEMBLE
	CON(1)	8
RPL
xNAME TB
::
  CK1&Dispatch
  str
  ::
    GARBAGE				( * Make safe * )
    CODE
sTBRPL	EQU 5		* Flag RPL mode

		GOSBVL	=SAVPTR
		GOSBVL	=GetStrLenStk
		GOSBVL	=MAKE$
		GOSBVL	=GetStrLenStk
		D1=D1-	5
		A=DAT1	A		->$input
		CD1EX
		D1=C
		D1=D1+	5
		A=A+C	A
		B=A	A		->input end
		CLRST
		GOSUB	TBsetmode1	Guess starting mode

TBloop		CD0EX
		R1=C			R1[A] = ->output
		D0=C
		CD1EX
		R2=C			R2[A] = ->input
		D1=C
		?C>=B	A
		GOYES	TBexit		End of input reached - quit
		?ST=1	sTBRPL
		GOYES	+
		GOSUB	TBass
		GOTO	TBloop
+		GOSUB	TBrpl
		GOTO	TBloop

TBexit		GOSBVL	=Shrink$
		GOVLNG	=GPOverWrR0Lp

TBrpl		GOSUB	TBcomment	Copy comment line as is
		GOSUB	TBcopywhite	Copy leading whitespace
		GOSUB	TBtoass?	Switch to assembly if needed
		GOTO	TBcopyline
TBass		GOSUB	TBcomment	Copy comment line as is
		GOSUB	TBcopytab	Copy leading white with tabs
		GOSUB	TBtorpl?	Switch to RPL if needed
		GOSUB	TBcopyblack	Copy opcode
		GOSUB	TBcopytab	Tabify
		GOSUB	TBcopyblack	Copy argument field
		GOSUB	TBcopytab	Tabify
*					And copy comments as is

* Copy the line starting from D0 to end of line (or input) to output

TBcopyline	LCASC	'\n'
-		AD1EX
		D1=A
		?A>=B	A
		RTNYES			Do not copy further than input end
		A=DAT1	B
		DAT0=A	B
		D1=D1+	2
		D0=D0+	2
		?A#C	B
		GOYES	-		Nor beyond newline characters
		RTN

* Copy word from input to output

TBcopyblack	LCASC	' '
-		AD1EX
		D1=A
		?A>=B	A
		GOYES	TBcopyabort	Do not copy past the end of input
		A=DAT1	B
		?A<=C	B
		RTNYES			Do not copy whitespace
		DAT0=A	B
		D1=D1+	2
		D0=D0+	2
		GONC	-
TBcopyabort	C=RSTK
		RTN

* Copy whitespace from input to output

TBcopywhite	LCASC	' '
-		AD1EX
		D1=A
		?A>=B	A
		GOYES	TBcopyabort	Do not copy past the end of input
		A=DAT1	B
		?A>C	B
		RTNYES
		DAT0=A	B
		D1=D1+	2
		D0=D0+	2
		GONC	-

* Copy whitespace with tabs to output

TBcopytab	D=0	A		spaces=0
-		AD1EX
		D1=A
		?A>=B	A
		GOYES	TBcopyabort	Do not copy past the end of input
		A=DAT1	B
		LCASC	' '
		?A>C	B
		RTNYES			Stop at non-whitespace
		LCASC	'\n'
		?C=A	B
		RTNYES			Stop at newline too
		D1=D1+	2
		?D#0	A
		GOYES	-		Back immediately if no space yet
		D=D+1	A		spaces=1
		LCASC	'\t'		Else output single tabulator
		DAT0=C	B
		D0=D0+	2
		GONC	-		And strip the remaining whitespace

* Do not tabify comment lines

TBcomment	A=DAT1	B
		LCASC	'*'
		?A#C	B
		RTNYES
		C=RSTK
		GOTO	TBcopyline

* Switch mode to RPL if proper token is found

TBtorpl?	A=DAT1	14
		C=A	W
		LCSTR	'RPL'
		?A=C	W
		GOYES	TBtorpl
		LCSTR	'LABEL'
		?A=C	W
		GOYES	TBtorpl
		LCSTR	'ENDCODE'
		?A#C	W
		RTNYES
TBtorpl		ST=1	sTBRPL

* Reset variables to do the line again

TBredoline	C=R1
		D0=C
		C=R2
		D1=C
		C=RSTK
		RTN

* Switch mode to assembly if proper token is found

TBtoass?	A=DAT1	W
		C=A	W
		LCSTR	'CODE'
		?C=A	W
		GOYES	TBtoass
		LCSTR	'CON('		Hmm, works for PCO's but..
		?C=A	W
		GOYES	+
		LCSTR	'ASSEMBLE'
		?C#A	W
		RTNYES
TBtoass		ST=0	sTBRPL
		RTN
+		ST=0	sTBRPL
		GOTO	TBredoline

* Set initial mode

TBsetmode1	A=DAT1	B
		LCASC	'='
		?A=C	B
		GOYES	TBtoass		Set assembly mode
		LCASC	' '
		?A<=C	A
		GOYES	TBtoass		Set assembly mode
		ST=1	sTBRPL		Set rpl mode
		RTN

   ENDCODE
  ;
;
**********************************************************************