Module io2 =
Begin

Require 'bliss.req';

External Routine
	OutCrlf		: Novalue,
	Output		: Novalue;

Own
	save;

!
! io.bli - routines for writing to the files
!

Macro
	va_arg(i)	=	(i = .i + 1; ActualParameter(.i)) %;

! routine to print the name of a symbol

Global Routine OUTSYM(S : Ref GT) : Novalue =
Begin
    Local
	K		: Integer;

    K = .S[gt_type];
    If .K Eql T_LITERAL Then
	S = .S[gt_disp];
    OutLexeme(.K,.S)
End;

Global Routine OutLexeme(K : Integer,S : Ref GT) : Novalue =
Begin
    Local
	P		: Ref GT;

    Case .K From 0 To T_MACRO_ARG Of Set
	[T_DELIMITER]:
	    ;

	[T_LITERAL]:
	    Print(AZ('%d'),.S);

	[T_VARIABLE]:
	    Begin
	    Print(AZ('@'));
	    OUTSYM(.s[gt_disp])
	    End;

	[T_SYMBOL,T_LEX_FUNC,T_LEX_COND,T_LEX_QUOTE]:
	    OutSym(.S[st_name]);

	[T_NODE]:
	    Print(AZ('[%x]'),.S);

	[T_STRING]:
	    Print(AZ('''%q'''),.S);

	[T_STRUCT_ARG]:
	    Print(AZ('STRACT-%d'),.S);

	[T_NAME]:
	    Print(AZ('%s'),S[nt_data]);

	[T_MACRO]:
	    Begin
	    Print(AZ('MACRO-'));
	    OutSym(.S[st_name])
	    End;

	[T_MACRO_ARG]:
	    Print(AZ('MACRACT-%d'),.S)
    Tes
End;

! routine to return the name of a delimiter

Global Routine DELNAME(DTIND : Integer) =
Begin
    Literal
	OFINDEX		= 15;		! SEE DETREMAIN AND OF1
    Local
	P		: Ref ST;
    Own
	TEMP		: Vector[2,Byte];

    P = .DTPF[.DTIND];
    If .P NEQA 0 Then
	Return P[nt_data];
    TEMP[0] = .DTIND;
    TEMP[1] = 0;
    Return TEMP
End;

!
! Convert(s,n,r) - convert a number to a string
!

Routine Convert(s : Ref Vector[,Byte],n,r) =
Begin
    Local
	f;
    Bind
	hex = Uplit('0123456789abcdef') : Vector[,Byte];

    f = 0;
    If .r Lss 0 Then
	Begin
	r = -.r;
	If .n Lss 0 Then
	    Begin
	    n = -.n;
	    f = 1;
	    End
	End;
    s = .s + 31;
    s[0] = 0;
    Do
	Begin
	s = .s - 1;
	s[0] = .hex[.n Mod .r];
	n = .n / .r
	End
    While .n Gtr 0;
    If .f Then
	Begin
	s = .s - 1;
	s[0] = '-'
	End;
    Return .s
End;

!
! convert a string lexeme
!

Routine StringLiteral(buff : Ref Vector[,Byte],s : Ref GT) =
Begin
    Local
	N		: Integer,
	C		: Integer,
	J		: Integer,
	P		: Ref Vector[,Byte];

    N = .S[tx_size];
    P = S[tx_data];
    J = 0;
    Incr I From 1 To .N Do
	Begin
	C = .P[0];
	P = .P + 1;
	If .C Lss 32 Or .C Gtr 126 Then
	    Begin
	    buff[.J] = '\';
	    J = .J + 1;
	    Selectone .C Of Set
		[0]:
		    C = '0';
		[10]:
		    C = 'n';
		[13]:
		    C = 'r';
		[12]:
		    C = 'f';
		[9]:
		    C = 't';
		[Otherwise]:
		    Begin
		    buff[.J]   = .C<6,2> + '0';
		    buff[.J+1] = .C<3,3> + '0';
		    C= .C<0,3> + '0'
		    End
	    Tes
	    End;
	buff[.J] = .C;
	J = .J + 1
	End;
    buff[.J] = 0;
    Return .buff
End;

!
! Print(msg,...) - display a formatted message
!

Global Routine Print(ctl : Ref Vector[,Byte]) =
Begin
    Builtin
	actualparameter;
    Local
	c,i,k,len,
	jst,padding,sts,
	s		: Ref Vector[,Byte],
	temp		: Vector[1024,Byte];
    Label
	aaa;

    sts = 0;
    i = 1;
    While (c = ch$rchar_a(ctl)) Neq 0 Do
	If .c Eql '\' Then
	    Begin
	    c = ch$rchar_a(ctl);
	    If .c Eql 't' Then
		Output(9)
	    Else If .c Eql 'n' Then
		OutCrlf()
	    Else If .c Eql 'f' Then
		Output(12)
	    Else
		Output(.c)
	    End
	Else If .c Neq '%' Then
	    Output(.c)
	Else
	    aaa: Begin
	    len = 0;
	    jst = 0;
	    padding = ' ';
	    c = ch$rchar_a(ctl);
	    If .c Eql '-' Then
		Begin
		jst = 1;
		c = ch$rchar_a(ctl)
		End;
	    If .c Eql '0' Then
		Begin
		padding = '0';
		c = ch$rchar_a(ctl)
		End;
	    If .c Eql '*' Then
		Begin
		len = va_arg(i);
		c = ch$rchar_a(ctl)
		End
	    Else
		While .c Geq '0' And .c Leq '9' Do
		    Begin
		    len = .len * 10 + .c - '0';
		    c = ch$rchar_a(ctl)
		    End;
	    s = temp;
	    Case .c From 'b' To 'x' Of Set

		[Inrange,Outrange]:
		    Begin
		    s[0] = .c;
		    s[1] = 0
		    End;

		['b']:
		    Begin
		    save = .device;
		    Leave aaa
		    End;

		['c']:
		    Begin
		    s[0] = va_arg(i);
		    s[1] = 0
		    End;

		['d']:
		    s = Convert(temp,va_arg(i),-10);

		['e']:
		    Begin
		    device = .save;
		    Leave aaa
		    End;

		['l']:
		    s = DelName(va_arg(i));

		['m']:
		    Begin
		    device = .len;
		    If .flg_tty Or Not .swit_list Then
			device<1,1> = 0;
		    Leave aaa
		    End;

		['p']:
		    Begin
		    OutSym(va_arg(i));
		    Leave aaa
		    End;

		['q']:
		    s = StringLiteral(temp,va_arg(i));

		['o']:
		    s = Convert(temp,va_arg(i),8);

		['r']:
		    Begin
		    sts = 1;
		    Leave aaa
		    End;

		['s']:
		    s = va_arg(i);

		['t']:
		    Begin
		    s[0] = 0;
		    c = va_arg(i)
		    End;
		['u']:
		    s = Convert(temp,va_arg(i),10);

		['x']:
		    s = Convert(temp,va_arg(i),16)
	    Tes;
	    k = ch$find_ch(256,.s,0) - .s;
	    If Not .jst Then
		While .len Gtr .k Do
		    Begin
		    Output(.padding);
		    len = .len - 1
		    End;
	    While (c = ch$rchar_a(s)) Neq 0 Do
		Output(.c);
	    If .jst Then
		While .len Gtr .k Do
		    Begin
		    Output(.padding);
		    len = .len - 1
		    End
	    End;
    Return .sts
End;

End
Eludom