DNA.
wyrm-io
Version.
1.0.9
Namespace.
::wyrm ::wyrm::wif
Command.
::wyrm::io
Language.
c
Manpage.
wyrm-io (4WY)
Manpage.
cread (3WY)
Manpage.
cwrite (3WY)
Manpage.
cprintf (3WY)
Manpage.
rprintf (3WY)
Manpage.
dprintf (3WY)
Manpage.
io (1WY)
Manpage.
mc (1WY)
Manpage.
qio (1WY)
Testbase.
Test Script
Test Report
Import.
Interface.
wyrmwif
Export.
Implementation.
wyrm-io.c
Interface.
wyrm-io.h
Object.
wyrm-io.o
System.
wyrm-io.sys
wyrm-io.sys

<stdio>-ish Version of Tcl I/O.

Sections.
Introduction
I/O Constants and Variables
Character and String Reading
Character and String Writing
Format Values into an Object or Channel
format string
formatter
subst
va-args replacement
msgcat
Format Values into the Interpretter
Message Catalog Interface
I/O interpretter
Debugging
Command Interface
Testing interface
Make.
Object.
compile -c -o [
  export object
] [
  export implementation
] -- -list [import interface] [export interface]
    

Introduction

 
    
top 

1 :: A simple interface to Tcl I/O in the style of stdio.h. However, the channel always comes first in calls, unlike stdio, where the FILE comes randomly as the first or last parameter.

Copyright (C) 2002 SM Ryan

Wyrmwif Tcl extensions. For non-profit uses only, provided this copyright is preserved on all copies, this work may be freely copied, modified, redistributed, compiled, and incorporated in other works. This work is distributed with no warranty of any kind; no author or distributor accepts any responsibility for the consequences of using it, or for whether it serves any particular purpose or works at all, unless he or she says so in writing.

^
 
section    top 

#ifndef WYRM_IO_H
#define WYRM_IO_H


	//	wyrm-io.dna - Copyright (C) 2002 SM Ryan. All rights reserved.


	#include "wyrmwif.h"
	#include <stdio.h>
	#include <stdarg.h>

	<Character and string read interface>
	<Character and string write interface>
	<Formatted output interface>
	<Format into interpretter interface>
^
Definition continued at: 7, 8, 9, 12, 110, 111, 114, 119, 122, 125.
Interface wyrm-io.h
 
 
section    top 
^
Definition continued at: 113, 120, 123.
Implementation wyrm-io.c
 
 
section    top 

#include <ctype.h>
#include "wyrm-io.h"
#include "wyrm-io.sys"
^
Definition continued at: 107.
Referenced at: 3.
 
 
   ^
    

I/O Constants and Variables

 
    
top 
5. wyrm-io (4WY) ::

NAME

wyrm-io.h — wyrm-io globals.

synopsis

<wyrm-io (4WY) Synopsis>

description

<wyrm-io (4WY) Description>

This is just a <stdio.h> like interface to Tcl. This permits character or string at a time calls cgetc(channel) and cputc(channell,ch), as well formatted output cprintf.

<Thread safe>

SEE ALSO

io (1WY), cread (3WY), cwrite (3WY), cprintf (3WY), rprintf (3WY), dprintf (3WY).
^
Manpage wyrm-io (4WY)
 
 
section    top 
^
Definition continued at: 10.
Referenced at: 5.
 
 
section    top 
#define chstdin—standard input channel.
#define chstdin (Tcl_GetStdChannel(TCL_STDIN))
^
Defined at: 2.
Definition continued at: 8, 9, 12, 110, 111, 114, 119, 122, 125.
Interface wyrm-io.h
 
 
section    top 
#define chstdout—standard output channel.
#define chstdout (Tcl_GetStdChannel(TCL_STDOUT))
^
Defined at: 2.
Definition continued at: 9, 12, 110, 111, 114, 119, 122, 125.
Interface wyrm-io.h
 
 
section    top 
#define chstderr—standard error channel.
#define chstderr (Tcl_GetStdChannel(TCL_STDERR))
^
Defined at: 2.
Definition continued at: 12, 110, 111, 114, 119, 122, 125.
Interface wyrm-io.h
 
 
section    top 
^
Defined at: 6.
Referenced at: 5.
 
 
section    top 
^
Referenced at: 5.
 
 
section    top 
type ioResult—Additional I/O results.
BLK—Input is blocked; no data was returned.
EOF—Input is ended; no data was returned.
ERR—An error occurred.

#if EOF==-1
	enum ioResult {BLK=-2,ERR=-3};
#elif EOF<-3
	enum ioResult {BLK=-1,ERR=-2};
#else
	enum ioResult {BLK=-3,ERR=-4};
#endif
^
Defined at: 2.
Definition continued at: 110, 111, 114, 119, 122, 125.
Interface wyrm-io.h
 
 
   ^
    

Character and String Reading

 
    
top 
^
Manpage cread (3WY)
 
 
section    top 

14 :: Character and string I/O just call Tcl_Write, Tcl_WriteObj, Tcl_Read, and Tcl_GetsObj with error returns refined (slightly).

^
 
section    top 
proc cgetc—Read one char and return the actual byte as nonnegative value or ERR, EOF, or BLK.
input channel—Channel to read from.
io (channel)—Contents of channel read and advanced passed the read chars.
int cgetc(Tcl_Channel channel);
^
Definition continued at: 18, 21, 24.
Referenced at: 2, 13.
 
 
section    top 

int cgetc(Tcl_Channel channel) {
	unsigned char b[1]; int N = cread(channel,b,1);
	return N>0 ? *b : N;
}
^
Definition continued at: 19, 22, 25.
Referenced at: 3, 13.
 
 
section    top 
^
Definition continued at: 20, 23, 26.
Referenced at: 13.
 
 
section    top 
proc cgeto—Returns a new object containing read characters or NULL if end-of-file or error.
Memory. Reference count set to 1; decrement to reclaim storage.
input channel—Channel to read from.
io (channel)—Contents of channel read and advanced passed the read chars.
Obj cgeto(Tcl_Channel channel);
^
Defined at: 15.
Definition continued at: 21, 24.
Referenced at: 2, 13.
 
 
section    top 

Obj cgeto(Tcl_Channel channel) {
	Obj obj = incr(Tcl_NewObj());
	int N = cgets(channel,obj);
	if (N==EOF || N==ERR) {
		decr(obj); obj = 0;
	}
	return obj;
}
^
Defined at: 16.
Definition continued at: 22, 25.
Referenced at: 3, 13.
 
 
section    top 
^
Defined at: 17.
Definition continued at: 23, 26.
Referenced at: 13.
 
 
section    top 
proc cgets—Read into an object and return the number of bytes read or ERR, EOF, or BLK.
input channel—Channel to read from.
io (channel)—Contents of channel read and advanced passed the read chars.
output obj—Object to append the input to. A partial line may have been read if BLK is returned.
Memory. Must already be allocated and initialised.
int cgets(Tcl_Channel channel,Obj obj);
^
Defined at: 15.
Definition continued at: 24.
Referenced at: 2, 13.
 
 
section    top 

int cgets(Tcl_Channel channel,Obj obj) {
	int N = Tcl_GetsObj(channel,obj);
	return	N>=0 ? N
		:	Tcl_Eof(channel) ? EOF
		:	Tcl_InputBlocked(channel) ? BLK
		:	ERR;
}
^
Defined at: 16.
Definition continued at: 25.
Referenced at: 3, 13.
 
 
section    top 
^
Defined at: 17.
Definition continued at: 26.
Referenced at: 13.
 
 
section    top 
proc cread—Read into the buffer and return the number of chars actual read, ERR, EOF, or BLK.
input channel—Channel to read from.
io (channel)—Contents of channel read and advanced passed the read chars.
input n—Maximum number of chars to read.
output p—Receives read bytes.
int cread(Tcl_Channel channel,ptr p,int n);
^
Defined at: 15.
Referenced at: 2, 13.
 
 
section    top 

int cread(Tcl_Channel channel,ptr p,int n) {
	int N = Tcl_Read(channel,(chars)p,n);
	return	N>0 ? N
		:	Tcl_Eof(channel) ? EOF
		:	Tcl_InputBlocked(channel) ? BLK
		:	ERR;
}
^
Defined at: 16.
Referenced at: 3, 13.
 
 
section    top 
^
Defined at: 17.
Referenced at: 13.
 
 
section    top 
    Read.
      cread
        Read data.
          SIO100
        Read error.
          SIO101
        Read blocking.
          SIO102
        Read end of file.
          SIO103
          SIO104
      cgetc
        Read ASCII character.
          SIO110
        Read non-ASCII character.
          SIO111
        Read error.
          SIO112
        Read blocking.
          SIO113
        Read end of file.
          SIO114
          SIO115
      cgets
        Read string onto empty string.
          SIO120
        Read string onto partial string.
          SIO121
        Read last line which has <nl%gt;.
          SIO122
        Read last line which does not have <nl%gt;.
          SIO123
        Read error.
          SIO124
        Read blocking.
          SIO125
        Read end of file.
          SIO126
          SIO127
      cgeto
        Read string.
          SIO130
        Read last line which has <nl%gt;.
          SIO131
        Read last line which does not have <nl%gt;.
          SIO132
        Read error.
          SIO133
        Read blocking.
          SIO134
        Read end of file.
          SIO135
          SIO136
^
Referenced at: 124.
 
 
   ^
    

Character and String Writing

 
    
top 
^
Manpage cwrite (3WY)
 
 
section    top 
proc cputc—Write one character and return the number of chars actually written (1) or ERR.
input channel—Channel to write to.
output (channel)—Contents of channel written and advanced.
input ch—Character to write.
int cputc(Tcl_Channel channel,int ch);
^
Definition continued at: 32, 35, 38.
Referenced at: 2, 28.
 
 
section    top 

int cputc(Tcl_Channel channel,int ch) {
	char b[1]; *b = ch; return cwrite(channel,b,1);
}
^
Definition continued at: 33, 36, 39.
Referenced at: 3, 28.
 
 
section    top 
^
Definition continued at: 34, 37, 40.
Referenced at: 28.
 
 
section    top 
proc cputo—Write one object and return the number of chars actually written or ERR.
input channel—Channel to write to.
output (channel)—Contents of channel written and advanced.
input obj—Object whose string representation is written.
int cputo(Tcl_Channel channel,Obj obj);
^
Defined at: 29.
Definition continued at: 35, 38.
Referenced at: 2, 28.
 
 
section    top 

int cputo(Tcl_Channel channel,Obj obj) {
	if (obj) {
		int N = Tcl_WriteObj(channel,obj);
		return	N>0 ? N
			:	ERR;
	}else
		return 0;
}
^
Defined at: 30.
Definition continued at: 36, 39.
Referenced at: 3, 28.
 
 
section    top 
^
Defined at: 31.
Definition continued at: 37, 40.
Referenced at: 28.
 
 
section    top 
#define cputs—Write string and return the number of chars actually written or ERR.
input channel—Channel to write to.
output (channel)—Contents of channel written and advanced.
input string—String to write.
#define cputs(channel,string) (cwrite(channel,(chars)(string),-1))
^
Defined at: 29.
Definition continued at: 38.
Referenced at: 2, 28.
 
 
section    top 
^
Defined at: 30.
Definition continued at: 39.
Referenced at: 3, 28.
 
 
section    top 
^
Defined at: 31.
Definition continued at: 40.
Referenced at: 28.
 
 
section    top 
proc cwrite—Write buffer and return the number of chars actually written or ERR.
input channel—Channel to write to.
output (channel)—Contents of channel written and advanced.
input p—Sends written bytes.
input n—Maximum number of chars to write.
int cwrite(Tcl_Channel channel,ptr p,int n);
^
Defined at: 29.
Referenced at: 2, 28.
 
 
section    top 

int cwrite(Tcl_Channel channel,ptr p,int n) {
	int N = Tcl_Write(channel,(chars)p,n);
	return	N>0 ? N
		:	ERR;
}
^
Defined at: 30.
Referenced at: 3, 28.
 
 
section    top 
^
Defined at: 31.
Referenced at: 28.
 
 
section    top 
    Write.
      cwrite
        Write data.
          SIO200
        Write data with zero-byte.
          SIO201
        Write error.
          SIO202
        Write blocking.
          SIO203
        Write end of file.
          SIO204
          SIO205
      cputc
        Write ASCII data.
          SIO210
        Write error.
          SIO212
        Write blocking.
          SIO213
        Write end of file.
          SIO214
          SIO215
      cputs
        Write data.
          SIO220
        Write error.
          SIO221
        Write blocking.
          SIO222
        Write end of file.
          SIO223
          SIO224
      cputo
        Write data.
          SIO230
        Write error.
          SIO231
        Write blocking.
          SIO232
        Write end of file.
          SIO233
          SIO234
^
Referenced at: 124.
 
 
   ^
    

Format Values into an Object or Channel

 
    
top 
^
Manpage cprintf (3WY)
 
 
section    top 

43. Formatted output implementation :: This is much the same as the Tcl format command with a few features added. The input var-args list is read according to the format string %-formatters, but an alternate input type can be added. For example,

"%s" expects the next argument to be a string.

"%d" expects the next argument to be an integer.

"%{i}s" expects the next argument to be an integer packed with multiple characters. The characters are extracted and presented to format as a string.

"%{y}d" expects the next argument to be an object and presents it as an integer.

While formatters are examined for input and output types, the argument position is ignored. Arguments must be in the same order as their format specifier. To handle positional formats, transfer arguments in order for their first uses, and then use the empty input type "{}" for reoccurences. If the width or precision of a formatter includes an "*", the next argument is assumed to be an integer and packed unmodified.

input type c, d, i, o, x, X:
output type c, d, i, o, x, X
No conversion needed.
output type u
Signedness ignored.
output type f, e, E, g, G
Floated.
output type s
The integer value is regarded as a packed sequence of characters, which are unpacked and formatted as a string. Leading zero bytes are skipped. Sign extension is disabled so leading 0xFF characters are not created unless they actually occur.
input type u:
output type c, d, i, o, x, X
Unsignedness ignored.
output type u
No conversion needed.
output type f, e, E, g, G
Floated.
output type s
The unsigned value is regarded as a packed sequence of characters, which are unpacked and formatted as a string. Leading zero bytes are skipped. Sign extension is disabled so leading 0xFF characters are not created unless they actually occur.
input type f, e, E, g, G:
output type c, d, i, o, x, X
Truncated to integer.
output type u
Truncated to unsigned.
output type f, e, E, g, G
No conversion needed.
output type s
Not allowed.
input type s:
output type c, d, i, o, x, X
Not allowed.
output type u
Not allowed.
output type f, e, E, g, G
Not allowed.
output type s
No conversion needed.
input type n:
output type c, d, i, o, x, X
Not allowed.
output type u
Not allowed.
output type f, e, E, g, G
Not allowed.
output type s
The first n characters are formatted, including any null characters.
input type y:
Object formatted without conversion.
input type r:
Result formatted without conversion.
empty input:
Nothing is added to the argument list.

Format String Syntax

<format string syntax>

format-item ::= %% | subst-trigger | var-args-replacement | msgcat-load | formatter | any-character-except-%

<subst formatter syntax> <var-args replacement formatter syntax> <msgcat formatter syntax> <formatter syntax>
<subst Description><var-args Description><msgcat Description>
^
Definition continued at: 45, 47, 49, 51.
Referenced at: 3, 42.
 
 
section    top 
proc cprintf—Formatted print to a channel and return number of chars actually written or ERR.
input channel—Channel to write to.
output (channel)—Contents of channel written and advanced.
input format—The format string, augmented with %$ and input types.
input ...—List of formatted values.
io o—An internal Tcl interpretter. It is not directly available, but commands can be evaluated in it with decr(oprintf("%$tcl command"))
int cprintf(Tcl_Channel channel,chars format,...);
^
Definition continued at: 46, 48, 50.
Referenced at: 2, 42.
 
 
section    top 

int cprintf(Tcl_Channel channel,chars format,...) {
	va_list args; Obj obj; int n;
	va_start(args,format); obj = voprintf(format,args); va_end(args);
	n = cputo(channel,obj); decr(obj);
	return n;
}
^
Defined at: 43.
Definition continued at: 47, 49, 51.
Referenced at: 3, 42.
 
 
section    top 
proc coprintf—Return a formatted string on an object.
Memory. New object with reference count 1.
input args—List of formatted values.
input format—The format string, augmented with %$ and input types.
io iointr—An internal Tcl interpretter. It is not directly available, but commands can be evaluated in it with decr(oprintf("%$tcl command"))
Obj oprintf(chars format,...);
^
Defined at: 44.
Definition continued at: 48, 50.
Referenced at: 2, 42.
 
 
section    top 

Obj oprintf(chars format,...) {
	va_list args; Obj obj;
	va_start(args,format); obj = voprintf(format,args); va_end(args);
	return obj;
}
^
Defined at: 43.
Definition continued at: 49, 51.
Referenced at: 3, 42.
 
 
section    top 
proc vcprintf
input channel—Channel to write to.
output (channel)—Contents of channel written and advanced.
input format—The format string, augmented with %$ and input types.
input args—List of formatted values.
io iointr—An internal Tcl interpretter. It is not directly available, but commands can be evaluated in it with decr(oprintf("%$tcl command"))
int vcprintf(Tcl_Channel channel,chars format,va_list args);
^
Defined at: 44.
Definition continued at: 50.
Referenced at: 2, 42.
 
 
section    top 

int vcprintf(Tcl_Channel channel,chars format,va_list args) {
	Obj obj; int n;
	obj = voprintf(format,args);
	n = cputo(channel,obj); decr(obj);
	return n;
}
^
Defined at: 43.
Definition continued at: 51.
Referenced at: 3, 42.
 
 
section    top 
proc voprintf—Return a formatted string on an object.
Memory. New object with reference count 1.
input format—The format string, augmented with %$ and input types.
input args—List of formatted values.
io iointr—An internal Tcl interpretter. It is not directly available, but commands can be evaluated in it with decr(oprintf("%$tcl command"))
Obj voprintf(chars format,va_list args);
^
Defined at: 44.
Referenced at: 2, 42.
 
 
section    top 

Obj voprintf(chars format,va_list args) {
	ThreadData *thread = Tcl_GetThreadData(&ioKey,sizeof(ThreadData));
	Obj result = 0;
	<Declare msgcat variables>
	<Format string traversal loop variables>
	<Parse the entire format string and varargs list>
	<Format the list>
	<Subst the list>
	<Collect loop variables>
	<Release msgcat variables>
	return result;
}
^
Defined at: 43.
Referenced at: 3, 42.
 
 
section    top 

Tcl_CmdInfo formatCmd; bool gotFormatCmd;
^
Definition continued at: 84, 93, 112.
Referenced at: 106.
 
 
section    top 
			
<Get I/O interpretter>
if (!thread->gotFormatCmd) {
	thread->gotFormatCmd = Tcl_GetCommandInfo(thread->iointr,"format",&thread->formatCmd);
}
if (thread->gotFormatCmd) {
	thread->formatCmd.objProc(thread->formatCmd.objClientData,thread->iointr,N,P1);
	result = incr(Tcl_GetObjResult(thread->iointr));
	Tcl_ResetResult(thread->iointr);
} else {
	result = incr(Tcl_NewStringObj("<couldn't find format command>",-1));
}
^
Referenced at: 51.
 
 
   ^
    

format string

 
    
top 
^
Referenced at: 43.
 
 
section    top 
chars f—Cursor to traverse the input format string.
chars f;
^
Definition continued at: 56, 58, 67, 82, 88.
Referenced at: 51.
 
 
section    top 
Obj format1—The translated format string.
Obj format1 = incr(Tcl_NewObj());
^
Defined at: 55.
Definition continued at: 58, 67, 82, 88.
Referenced at: 51.
 
 
section    top 

if (f[0]=='%' && f[1]=='%') {
	Tcl_AppendToObj(format1,f,2); f+=2;
}else if (f[0]=='%' && f[1]=='$') {
	<Trigger call of subst command>
}else if (f[0]=='%' && f[1]=='P') {
	<Var-args replacement by an array of objects>
}else if (f[0]=='%' && f[1]=='#') {
	<Substitute a message catalog string>
}else if (*f!='%') {
	Tcl_AppendToObj(format1,f,1); f+=1;
}else {
	<Formatter variables>
	Tcl_AppendToObj(format1,f,1); f+=1;
	<Parse and translate the formatter>
	if (!varargsReplaced) {
		<Move formatter varargs to argument list>
	}
}
^
Referenced at: 60.
 
 
section    top 

Obj *P,*P1; int N;
^
Defined at: 55.
Definition continued at: 67, 82, 88.
Referenced at: 51.
 
 
section    top 

decr(P1[0]);
decr(P1[1]);
dispose(P1);
^
Definition continued at: 68.
Referenced at: 51.
 
 
section    top 

for (f=format; *f; ) {
	<Parse and translate step the format string>
}
Tcl_ListObjGetElements(0,list,&N,&P);
P1 = nheap(N+2,Obj);
P1[0] = incr(Tcl_NewStringObj("format",-1));
P1[1] = format1;
memcpy(P1+2,P,N*sizeof(Obj));
N += 2;
^
Referenced at: 51.
 
 
   ^
    

formatter

 
    
top 
^
Definition continued at: 65.
Referenced at: 43.
 
 
section    top 

int numberAsterisks = 0;
int intype=0,intype1=0,inmod=0,outtype=0,outtype1=0,outmod=0;
int suffix=0;
chars input;
^
Definition continued at: 66, 73, 75.
Referenced at: 57.
 
 
section    top 

while (*f!=0 && *f!='{' && !isalpha(*f)) {
	numberAsterisks += *f=='*';
	Tcl_AppendToObj(format1,f,1); f+=1;
}
if (f[0]=='{' && f[1]=='}') {
	f += 2;
	while (*f && (!isalpha(*f) || tolower(*f)=='h' || tolower(*f)=='l')) {
		Tcl_AppendToObj(format1,f,1); f+=1;
	}
	continue;
}
if (*f=='{') {
	chars F = strchr(f+1,'}');
	input = f+1;
	f = F ? F+1 : f+1;
}else {
	input = "";
}
if (tolower(*f)=='h') {
	outmod = 1; Tcl_AppendToObj(format1,f,1); f+=1;
}else if (tolower(*f)=='l') {
	outmod = 2; Tcl_AppendToObj(format1,f,1); f+=1;
}
if (isalpha(*f)) {
	outtype = *f; Tcl_AppendToObj(format1,f,1); f+=1;
}
if (isalpha(*input)) {
	if (tolower(*input)=='h') {
		inmod = 1; input+=1;
	}else if (tolower(*input)=='l') {
		inmod = 2; input+=1;
	}
	if (isalpha(*input)) {
		intype = *input; input+=1;
	}
}else {
	intype = outtype; inmod = inmod;
}
if (*input=='+' || *input=='-') {
	suffix = *input++;
}
^
Referenced at: 57.
 
 
section    top 

while (numberAsterisks-->0) {
	Obj count = Tcl_NewIntObj(va_arg(args,int));
	Tcl_ListObjAppendList(0,list,count);
}
^
Referenced at: 69.
 
 
section    top 
^
Defined at: 61.
Referenced at: 43.
 
 
section    top 

enum {i=1,u=2,r=3,s=4,n=5,y=6,z=7,i0=10,u0=20,r0=30,s0=40,n0=50,y0=60,z0=70};
enum {ii=i0+i,iu=i0+u,ir=i0+r,is=i0+s};
enum {ui=u0+i,uu=u0+u,ur=u0+r,us=u0+s};
enum {ri=r0+i,ru=r0+u,rr=r0+r};
enum {ss=s0+s};
enum {ns=n0+s};
enum {yi=y0+i,yu=y0+u,yr=y0+r,ys=y0+s};
enum {zi=z0+i,zu=z0+u,zr=z0+r,zs=z0+s};
#if defined(ASCII)
	static unsigned char baseType[] = {
		//a b c d e f g h i j k l m n o p q r s t u v w x y z
		0,0,0,0,0,r,0,r,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,i,0,0,0,0,0,0,0,
		0,0,0,i,i,r,r,r,0,i,0,0,0,0,n,i,0,0,z,s,0,u,0,0,i,y,0,0,0,0,0
	};
	enum {zerochar = '@',limitchar = 0x7f};
	#define printable(ch) (' '<=(ch) && (ch)<0x7F)
#else
	#error Unknown character set.
#endif
Obj arg; bool decrement;
^
Defined at: 62.
Definition continued at: 73, 75.
Referenced at: 57.
 
 
section    top 
Obj list—The list of values to given to the Tcl format.

Obj list = incr(Tcl_NewObj());
^
Defined at: 55.
Definition continued at: 82, 88.
Referenced at: 51.
 
 
section    top 

decr(list);
^
Defined at: 59.
Referenced at: 51.
 
 
section    top 
			
<Move asterisks varargs>
if (zerochar<=intype && intype<limitchar)
	intype1 = baseType[intype-zerochar];
if (zerochar<=outtype && outtype<limitchar)
	outtype1 = baseType[outtype-zerochar];
switch (10*intype1+outtype1) {
	case ii:	case iu:	case ir:
		<Move integer vararg to numeric>
		break;
	case ui:	case uu:	case ur:
		<Move unsigned vararg to numeric>
		break;
	case ri:	case ru:	case rr:
		<Move real vararg to numeric>
		break;
	case is:	case us:
		<Convert integer vararg to string>
		break;
	case ss:
		<Move string vararg to string>
		break;
	case ns:
		<Move counted string vararg to string>
		break;
	case yi:	case yu:	case yr:	case ys:
		<Move object vararg to list>
		break;
	case zi:	case zu:	case zr:	case zs:
		<Move result vararg to list>
		break;
	default: {
		char B[30];
		sprintf(B,"<invalid conversion: %c->%c>",intype,outtype);
		arg = Tcl_NewStringObj(B,-1); decrement = false;
	}	break;
}
Tcl_ListObjAppendElement(0,list,arg);
if (decrement) decr(arg);
^
Referenced at: 57.
 
 
section    top 

switch (inmod) {
	case 0:
		arg = incr(Tcl_NewIntObj(va_arg(args,int)));
		decrement = true;
		break;
	case 1:
		arg = incr(Tcl_NewIntObj((short)va_arg(args,int)));
		decrement = true;
		break;
	case 2:
		arg = incr(Tcl_NewLongObj(va_arg(args,long)));
		decrement = true;
		break;
}
^
Referenced at: 69.
 
 
section    top 

switch (inmod) {
	case 0:
		arg = incr(Tcl_NewIntObj((int)va_arg(args,unsigned)));
		decrement = true;
		break;
	case 1:
		arg = incr(Tcl_NewIntObj((int)(unsigned short)va_arg(args,unsigned)));
		decrement = true;
		break;
	case 2:
		arg = incr(Tcl_NewLongObj((long)va_arg(args,unsigned long)));
		decrement = true;
		break;
}
^
Referenced at: 69.
 
 
section    top 

arg = incr(Tcl_NewDoubleObj(va_arg(args,double)));
decrement = true;
^
Referenced at: 69.
 
 
section    top 

char conv[sizeof( unsigned long)+1],*pconv;
unsigned long ival;
int lival;
^
Defined at: 62.
Definition continued at: 75.
Referenced at: 57.
 
 
section    top 

switch (intype1) {
	case i:
		switch (inmod) {
			case 0: ival = (unsigned long)va_arg(args,int); lival = sizeof(int); break;
			case 1: ival = (unsigned long)va_arg(args,int); lival = sizeof(int); break;
			case 2: ival = (unsigned long)va_arg(args,long); lival = sizeof(long); break;
		}
		break;
	case u:
		switch (inmod) {
			case 0: ival = (unsigned long)va_arg(args,unsigned); lival = sizeof(unsigned); break;
			case 1: ival = (unsigned long)va_arg(args,unsigned int); lival = sizeof(unsigned int); break;
			case 2: ival = (unsigned long)va_arg(args,unsigned long); lival = sizeof(unsigned long); break;
		}
		break;
}
pconv = conv+sizeof( unsigned long);
*pconv = 0; stringlen = 0;
while (pconv>conv && lival>0 && ival!=0) {
	*--pconv = ival; ival >>= 8; lival++; stringlen++;
}
string = pconv;
goto string;
^
Referenced at: 69.
 
 
section    top 

chars string; int stringlen;
^
Defined at: 62.
Referenced at: 57.
 
 
section    top 

	string = va_arg(args,chars); stringlen = -1;
string:
	if (suffix=='+') {
		chars copy; int xstring;
		if (stringlen<0) stringlen = strlen(string);
		copy = nheap(stringlen,char);
		for (xstring=0; xstring<stringlen; xstring++) {
			copy[xstring] = printable(string[xstring]) ? string[xstring] : '.';
		}
		arg = incr(Tcl_NewStringObj(copy,stringlen));
		dispose(copy);
	} else {
		arg = incr(Tcl_NewStringObj(string,stringlen));
	}
	decrement = true;
^
Referenced at: 69.
 
 
section    top 
 {
	stringlen = va_arg(args,int);
	string = va_arg(args,chars);
	goto string;
}
^
Referenced at: 69.
 
 
section    top 

arg = va_arg(args,Obj); decrement = suffix=='-';
if (!arg) {arg = incr(Tcl_NewObj()); decrement = true;}
^
Referenced at: 69.
 
 
section    top 

arg = incr(Tcl_GetObjResult(va_arg(args,Intr))); decrement = true;
^
Referenced at: 69.
 
 
   ^
    

subst

 
    
top 
^
Referenced at: 43.
 
 
section    top 
^
Referenced at: 43.
 
 
section    top 
bool triggerSubst—Whether '%$' was seen.
bool triggerSubst = false;
^
Defined at: 55.
Definition continued at: 88.
Referenced at: 51.
 
 
section    top 
triggerSubst = true; f+=2;
^
Referenced at: 57.
 
 
section    top 
Tcl_CmdInfo substCmd; bool gotSubstCmd;
^
Defined at: 52.
Definition continued at: 93, 112.
Referenced at: 106.
 
 
section    top 

if (triggerSubst) {
	<Get I/O interpretter>
	if (!thread->gotSubstCmd) {
		thread->gotSubstCmd = Tcl_GetCommandInfo(thread->iointr,"subst",&thread->substCmd);
	}
	if (thread->gotSubstCmd) {
		Obj Q[3];
		Q[0] = incr(Tcl_NewStringObj("subst",-1));
		Q[1] = incr(Tcl_NewStringObj("-nobackslashes",-1));
		Q[2] = incr(Tcl_NewStringObj("-novariables",-1));
		Q[3] = result;
		thread->substCmd.objProc(thread->substCmd.objClientData,thread->iointr,4,Q);
		result = incr(Tcl_GetObjResult(thread->iointr));
		Tcl_ResetResult(thread->iointr);
		decr(Q[0]); decr(Q[1]); decr(Q[2]); decr(Q[3]);
	}
}
^
Referenced at: 51.
 
 
   ^
    

va-args replacement

 
    
top 
^
Referenced at: 43.
 
 
section    top 
^
Referenced at: 43.
 
 
section    top 
bool varargsReplaced—If var-args replacement triggerred by %P.
bool varargsReplaced = false;
^
Defined at: 55.
Referenced at: 51.
 
 
section    top 

int nargs = va_arg(args,int);
Obj *pargs = va_arg(args,Obj*);
varargsReplaced = true; f+=2;
while (nargs-->0) Tcl_ListObjAppendElement(0,list,*pargs++);
^
Referenced at: 57.
 
 
   ^
    

msgcat

 
    
top 
^
Referenced at: 43.
 
 
section    top 
91. msgcat Description ::

%# msgcat

The format list can be redirected to a message catalog string. After a %# in the format string, the remainder of the format string, as is, is used as arguments to ::msgcat::mc. The resulting string is then replaces the remainder of the format string and formatting continues with the new string.

The ::msgcat is evaluated in the I/O interpretter. Additional ::msgcat subcomands can be evaluated with the ::wyrm::io evalcommand, such as

::wyrm::io eval ::msgcat::mclocale fr
::wyrm::io eval ::msgcat::mcload [file join [file dirname [info script]] msgs]

Before evaluating ::msgcat::mc the first time, the io interpretter will do the equivalent of

::wyrm::io eval eval [::msgcat::mc initialiser]
That is, it will search for a message "initialiser", and it will eval whatever string that returns. This permits catalog specific procs to initialised in the interpretter.

For example, an English-language catalog might include

::msgcat::mcset en initialiser {
proc numb {n sing plur} {if {$n==1} {return $sing} else {return $plur}}
proc ns {n} {numb $n "" "s"}
proc nes {n} {numb $n "" "es"}
proc vs {n} {numb $n "s" ""}
proc ves {n} {numb $n "es" ""}
proc is {n} {numb $n "is" "are"}
proc was {n} {numb $n "was" "were"}
proc has {n} {numb $n "has" "have"}
}
::msgcat::mcset en files-copied {%$%1$d file[ns %1$d] [was %1$d] copied.}
Then the call
rprintf(intr,"note: $#files-copied",1);
would be equivalent to
rprintf(intr,"note: %$%1$d file[ns %1$d] [was %1$d] copied.",1);
which would substitute in the I/O interpretter from
note: 1 file[ns 1] [was 1] copied.
into
note: 1 file was copied.
Similarily, rprintf(intr,"note: $#files-copied",4); would result in
note: 4 files were copied.

^
Referenced at: 43.
 
 
section    top 
			
<Get I/O interpretter>
if (!thread->msgcatInitialised) {
	int mi = Tcl_Eval(thread->iointr,"::msgcat::mc initialiser");
	if (mi==TCL_OK) {
		Obj ex = incr(Tcl_GetObjResult(thread->iointr));
		mi = Tcl_EvalObj(thread->iointr,ex);
	}
	thread->msgcatInitialised = true;
}
Tcl_VarEval(thread->iointr,"::msgcat::mc ",f+2,0);
decr(msgcatResult); msgcatResult = incr(Tcl_GetObjResult(thread->iointr));
f = Tcl_GetStringFromObj(msgcatResult,0);
^
Referenced at: 57.
 
 
section    top 
bool msgcatInitialised;
^
Defined at: 52.
Definition continued at: 112.
Referenced at: 106.
 
 
section    top 
Obj msgcatResult = 0;
^
Referenced at: 51.
 
 
section    top 
decr(msgcatResult);
^
Referenced at: 51.
 
 
section    top 
    cprintf and vcprintf
      Formatting values.
        Formattable types.
          Integer.
            SIO300
          Double.
            SIO301
          String.
            SIO302
          Unknown type.
            SIO303
          No values.
            SIO304
        Formatting conversions.
          From integer.
            From half.
              SIO310
            From long.
              SIO311
            To integer.
              SIO312
              To half.
                SIO313
              To long.
                SIO314
            To unsigned.
              SIO315
              To half.
                SIO316
              To long.
                SIO317
            To double.
              SIO318
            To string.
              SIO319
              Nonprintable suppressed.
                SIO320
            To unknown type.
              SIO321
          From unsigned.
            From half.
              SIO325
            From long.
              SIO326
            To integer.
              SIO327
              To half.
                SIO328
              To long.
                SIO329
            To unsigned.
              SIO330
              To half.
                SIO331
              To long.
                SIO332
            To double.
              SIO333
            To string.
              SIO334
              Nonprintable suppressed.
                SIO335
            To unknown type.
              SIO336
          From double.
            To integer.
              SIO340
            To unsigned.
              SIO341
            To double.
              SIO342
            To string.
              SIO343
          From string.
            To integer.
              Mumeric string.
                SIO345
              Nonnumeric string.
                SIO346
            To unsigned.
              SIO347
            To double.
              SIO348
            To string.
              SIO349
              Nonprintable suppressed.
                SIO350
          From counted string (n).
            To integer.
              Mumeric string.
                SIO355
              Nonnumeric string.
                SIO356
            To unsigned.
              SIO357
            To double.
              SIO358
            To string.
              SIO359
              Nonprintable suppressed.
                SIO360
          From object.
            Decrement reference count.
              SIO365
              SIO366
            To integer.
              SIO367
            To unsigned.
              SIO368
            To double.
              SIO369
            To string.
              SIO370
          From result.
            To integer.
              SIO375
            To unsigned.
              SIO376
            To double.
              SIO377
            To string.
              SIO378
              Nonprintable suppressed.
                SIO379
          From missing.
            To integer.
              SIO380
            To unsigned.
              SIO381
            To double.
              SIO382
            To string.
              SIO383
          From unknown.
            To integer.
              SIO385
            To unknown type.
              SIO386
        Substitution.
          Substitution of dollar sign and back slash.
            SIO390
          Substitution of a command.
            SIO391
          Eval procedure definition in I/O interpretter.
            SIO392
          Use procedure in I/O interpretter.
            SIO393
            SIO394
          Substitution result.
            Okay.
              SIO395
            Return.
              SIO398
            Error.
              SIO399
          io eval result.
            Okay.
              SIO400
            Return.
              SIO403
            Error.
              SIO404
        Writing to the channel.
          Write data.
            SIO450
          Write error.
            SIO451
          Write blocking.
            SIO452
          Write end of file.
            SIO453
            SIO454
        Message catalogs
          SIO475
          SIO476
      oprintf and voprintf
        Reference count.
          SIO500
        Format data.
          SIO501
^
Referenced at: 124.
 
 
   ^
    

Format Values into the Interpretter

 
    
top 
^
Manpage rprintf (3WY)
 
 
section    top 
proc rprintf—Format the list into the interpretter result; return the first argument if the format list begins with %!, otherwise TCL_OK.
input format—The format string
input args—List of formatted values.
output intr—The result is set to the formatted value.
input iointr—An internal Tcl interpretter. It is not directly available, but commands can be evaluated in it with decr(oprintf("%$tcl command"))
int rprintf(Intr intr,chars format,...);
^
Definition continued at: 100.
Referenced at: 2, 97.
 
 
section    top 

int rprintf(Intr intr,chars format,...) {
	va_list args; int rc;
	va_start(args,format); rc = vrprintf(intr,format,args); va_end(args);
	return rc;
}
^
Definition continued at: 101.
Referenced at: 3, 97.
 
 
section    top 
proc vrprintf—Format the list into the interpretter result; return the first argument if the format list begins with %!, otherwise TCL_OK.
input format—The format string
input args—List of formatted values.
output intr—The result is set to the formatted value.
input iointr—An internal Tcl interpretter. It is not directly available, but commands can be evaluated in it with decr(oprintf("%$tcl command"))
int vrprintf(Intr intr,chars format,va_list args);
^
Defined at: 98.
Referenced at: 2, 97.
 
 
section    top 

int vrprintf(Intr intr,chars format,va_list args) {
	Obj obj; int rc = TCL_OK;
	if (format[0]=='%' && format[1]=='!') {
		rc = va_arg(args,int); format += 2;
	}
	if (intr) {
		obj = voprintf(format,args);
		Tcl_SetObjResult(intr,obj);
		decr(obj);
	}
	return rc;
}
^
Defined at: 99.
Referenced at: 3, 97.
 
 
section    top 
    rprintf and vrprintf
      Format data.
        SIO600
      Return value.
        No %!.
          SIO610
        %! Present.
          Return okay.
            SIO620
          Return break.
            SIO621
          Return continue.
            SIO622
          Return return.
            SIO623
          Return error.
            SIO624
          Return too small.
            SIO625
          Return too large.
            SIO626
^
 
   ^
    

Message Catalog Interface

 
    
top 
103. mc (1WY) ::

NAME

mc — msgcat interface.

synopsis

::wyrm::mc [ -- ] message-id string...

::wyrm::mc -locale new-locale

::wyrm::mc -load dirname

description

The C code has an internal interface to the message catalog (::msgcat). The message catalog is run in an internal interpretter rather than the one this command is called from; an initialisation script from within the catalog can be specified and evaluated. Otherwise there is not much difference between

::wyrm::mc message p q r ...
and
subst [::msgcat::mc message p q r ...]

This command is intended to provide consistent initialisation and substitution services to C and Tcl code, rather than a ploy to usurp ::msgcat.

The second and third forms of the command are just short ways of doing

::wyrm::io eval ::msgcat::mclocale new-locale
::wyrm::io eval ::msgcat::mcload dirname
Other ::msgcat operations need to specified with "::wyrm::io eval".

SEE ALSO

wyrm-io (4WY).
^
Manpage mc (1WY)
 
 
section    top 

static int wyrm_IOMCCommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
	chars p;
	if (N<2) { usage:
		Tcl_ResetResult(intr);
		Tcl_AppendResult(intr,"usage: wyrm::mc <message id> ...",0);
		return TCL_ERROR;
	}
	P++,N--;
	p = Tcl_GetStringFromObj(*P,0);

	if (streq(p,"-locale")) {
		if (N!=2) {
			Tcl_ResetResult(intr);
			Tcl_AppendResult(intr,"usage: wyrm::mc -locale <locale>",0);
			return TCL_ERROR;
		}
		rprintf(intr,"%$[::msgcat::mclocale %{y}s]",P[1]);
	}else if (streq(p,"-load")) {
		if (N!=2) {
			Tcl_ResetResult(intr);
			Tcl_AppendResult(intr,"usage: wyrm::mc -load <dirname>",0);
			return TCL_ERROR;
		}
		rprintf(intr,"%$[::msgcat::mcload %{y}s]",P[1]);
	}else {
		Obj format;
		if (streq(p,"--")) {
			if (P++,N--<2) goto usage;
		}
		format = incr(Tcl_NewStringObj("%$%P%#",-1));
		Tcl_AppendObjToObj(format,*P++); N--;
		rprintf(intr,Tcl_GetStringFromObj(format,0),N,P);
		decr(format);
	}
	return TCL_OK;
}
^
Referenced at: 120.
 
 
   ^
    

I/O interpretter

 
    
top 

if (!thread->iointr) thread->iointr = newInterpretter();
^
Referenced at: 53, 85, 92, 113.
 
 
section    top 

static Tcl_ThreadDataKey ioKey;
typedef struct {
	Intr iointr;
	<Thread specific declarations>
} ThreadData;
^
Referenced at: 3, 5, 118.
 
 
section    top 

static Intr newInterpretter(void) {
	char initialisation [] =
		"source $tcl_library/init.tcl\n"
		"package require msgcat\n"
		"catch {\n"
			"package require wyrmwif\n"
			"namespace import wyrm::*\n"
		"}\n"
	;
	Intr intr = Tcl_CreateInterp();
	#ifdef TCL_MEM_DEBUG
		Tcl_InitMemory(intr);
	#endif
	if (Tcl_Init(intr) == TCL_ERROR) {
		fprintf(stderr,"interpretter Tcl_Init failed: %s\n",
				Tcl_GetStringResult(intr));
	}
	Tcl_SetVar(intr,"tcl_rcFileName","~/.tclshrc",TCL_GLOBAL_ONLY);
	Tcl_SourceRCFile(intr);
	if (Tcl_Eval(intr,initialisation)!=TCL_OK) {
		fprintf(stderr,"interpretter initialisation failed: %s\n%s",
				Tcl_GetStringResult(intr),initialisation);
	}
	return intr;
}
^
Defined at: 4.
Referenced at: 3.
 
 
section    top 

108 :: Tcl statements can be evalled in the I/O interpretter with oprintf or wyrm::io eval. The "%$" formatter also triggers to a call to subst which evals the command within the brackets '[' and ']'. oprintf returns the command result or error message.

oprintf("%$[%{y}s]",command);
^
 
   ^
    

Debugging

 
    
top 
109. dprintf (3WY) ::

NAME

dbreakpoint — Toggle breakpoint request.
dprintf — Debugging print.
require — Require predicate to be true.

synopsis


#include "wyrm-io.h"

int dbreakpoint(bool breakpoint);
void dprintf(char *format,...);
void require(predicate)

Private


void dprintfPosition(char *file,int line,bool abt);
void dprintfContent(char *format,...);

description

dbreakpoint provides a rudimentary debugging print. If dbreakpoint(false) has been called, dprintf and require write to stderr; dprintf returns and require aborts. If dbreakpoint(true) has been called, the formatted message is made available to the debugger as a breakpoint if this is sensible on the system. The caller's position and a newline is added to the formatted string.

These calls can only be used as statements. Some of these are #defines which do some tricky things.

The debugging routines are only available if DEBUG is #defined. Otherwise the calls are to dead code. dbreakpoint returns -1 if DEBUG is not #defined.

SEE ALSO

wyrm-io (4WY).
^
Manpage dprintf (3WY)
 
 
section    top 
proc dbreakpoint—Sets the breakpoint flag and returns the previous break point flag.
output (debugger)—If breakpoint, the next dprintf and require will cause a breakpoint to the debugger, if this is meaningful.
input breakpoint—Whether dprintf and require cause a breakpoint.

#ifdef DEBUG
	int dbreakpoint(bool breakpoint);
#else
	#define dbreakpoint(breakpoint)	(-1)
#endif
^
Defined at: 2.
Definition continued at: 111, 114, 119, 122, 125.
Interface wyrm-io.h
 
 
section    top 
#define dprintf—Formatted debugging print.
output (debugger)—The formatted string is made available to the debugger or console.
input format—The format string.
input args—List of formatted values.
input iointr—An internal Tcl interpretter.

#ifdef DEBUG
	void dprintfPosition(char *file,int line,bool abt);
	void dprintfContent(char *format,...);
	#define dprintf (dprintfPosition(__FILE__,__LINE__,false),dprintfContent)
#else
	#define dprintf  if (0)
#endif
^
Defined at: 2.
Definition continued at: 114, 119, 122, 125.
Interface wyrm-io.h
 
 
section    top 

#ifdef DEBUG
	Obj pos; bool bkp,abt;
#endif
^
Defined at: 52.
Referenced at: 106.
 
 
section    top 

#ifdef DEBUG
	void dprintfPosition(char *file,int line,bool abt1) {
		ThreadData *thread = Tcl_GetThreadData(&ioKey,sizeof(ThreadData));
		<Get I/O interpretter>
		thread->pos = oprintf(" (%s:%d)",file,line); thread->abt = abt1;
	}
	void dprintfContent(char *format,...) {
		ThreadData *thread = Tcl_GetThreadData(&ioKey,sizeof(ThreadData));
		<Get I/O interpretter>
		va_list args; Obj r; int k; chars s;
		va_start(args,format);
		r = voprintf(format,args);
		va_end(args);
		s = Tcl_GetStringFromObj(thread->pos,&k);
		Tcl_AppendToObj(r,s,k);
		decr(thread->pos); thread->pos = 0;
		s = Tcl_GetStringFromObj(r,&k);
		dprintfsys(r,s,k,thread->bkp,thread->abt);
		decr(r);
	}
	int dbreakpoint(bool breakpoint) {
		ThreadData *thread = Tcl_GetThreadData(&ioKey,sizeof(ThreadData));
		<Get I/O interpretter>
		int obkp = thread->bkp;
		thread->bkp = breakpoint;
		return obkp;
	}
#endif
^
Defined at: 3.
Definition continued at: 120, 123.
Implementation wyrm-io.c
 
 
section    top 
proc require—Require a predicate to be true. The program will be aborted if not.
output (debugger)—Receives requires failure if the predicate is false.
input predicate—Predicate is verified.

#ifdef DEBUG
	#define require(predicate) \
		((predicate) ? 1 : \
			(dprintfPosition(__FILE__,__LINE__,true), \
				dprintfContent("predicate failed: " #predicate), \
				0 \
			))
#else
	#define require(predicate)		1
#endif
^
Defined at: 2.
Definition continued at: 119, 122, 125.
Interface wyrm-io.h
 
 
section    top 

#define ASCII 1
#define EAGAIN 35

static void dprintfsys(Obj r,chars s,int k,bool bkp,bool abt) {
	if (bkp || abt) {
		debugstr(s);
	}else {
		cwrite(chstderr,s,k);
		cputs(chstderr,"\n");
	}
	if (abt) {
		#ifdef TESTING
			debugstr("ABORT ABORT ABORT");
			abort();
		#else
			abort();
		#endif
	}
}
^
System wyrm-io.sys
 
 
section    top 

#include <errno.h>
#define ASCII 1

static void dprintfsys(Obj r,chars s,int k,bool bkp,bool abt) {
	cwrite(chstderr,s,k);
	cputs(chstderr,"\n");
	if (abt) Tcl_Panic("%.*s",k,s);
}
^
System wyrm-io.sys
 
 
section    top 
    Debugging tests
      dbreakpoint
        Debugging turned off.
          SIO700
        Debugging turned on.
          Breakpoint off.
            SIO701
          Breakpoint on.
            SIO702
      dprintf
        Debugging turned off.
          SIO720
        Debugging turned on.
          Breakpoint off.
            SIO721U
            SIO722U
          Breakpoint on.
            SIO723U
            SIO724U
      require
        Debugging turned off.
          Require true.
            SIO730U
          Require false.
            SIO731U
        Debugging turned on.
          Require true.
            SIO732U
          Require false.
            SIO733U
^
Referenced at: 124.
 
 
   ^
    

Command Interface

 
    
top 
118. io (1WY) ::

NAME

io — I/O utilities.

synopsis

::wyrm::io debug

::wyrm::io testing

::wyrm::io breakpoint n

::wyrm::io dprintf string

::wyrm::io require expression

::wyrm::io eval command

description

The wyrm::io makes some useful oddities available at the command level.

wyrm::io debug returns 1 or 0 whether wyrm-io.c was compiled with DEBUG defined.

wyrm::io testing returns 1 or 0 whether wyrm-io.c was compiled with TESTING defined. If so, the qio command is also defined.

wyrm::io breakpoint call dbreakpoint with value n; it returns the previous breakpoint value, or -1 if DEBUG is not defined.

wyrm::io dprintf calls dprintf with the string; the result depends on the breakpoint value and whether it was compiled with DEBUG defined.

wyrm::io require calls require after evaluating the expression; the result depends on whether wyrm-io.c was compiled with DEBUG defined.

wyrm::io eval evaluates the command in the I/O interpretter.

<Thread safe>

SEE ALSO

wyrm-io (4WY).
^
Manpage io (1WY)
 
 
section    top 
int wyrm_IOCommandInit(Intr intr);
^
Defined at: 2.
Definition continued at: 122, 125.
Interface wyrm-io.h
 
 
section    top 

static int wyrm_IOCommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
	chars p;
	if (N<2) {
		Tcl_ResetResult(intr);
		Tcl_AppendResult(intr,"usage: wyrm::io <subcommand> ...",0);
		return TCL_ERROR;
	}
	P++,N--;
	p = Tcl_GetStringFromObj(*P,0); P++,N--;

	switch (*p) {
		case 'b': case 'B': {
			int n;
			if (N!=1) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: wyrm::io breakpoint <n>",0);
				return TCL_ERROR;
			}
			if (Tcl_GetIntFromObj(intr,*P,&n)!=TCL_OK) return TCL_ERROR;
			Tcl_SetObjResult(intr,Tcl_NewIntObj(dbreakpoint(n)));
		}	return TCL_OK;
		case 'd': case 'D':
			switch (p[1]) {
				case 'e': case 'E':
					if (N!=0) {
						Tcl_ResetResult(intr);
						Tcl_AppendResult(intr,"usage: wyrm::io debug",0);
						return TCL_ERROR;
					}
					#ifdef DEBUG
						Tcl_SetResult(intr,"1",TCL_STATIC);
					#else
						Tcl_SetResult(intr,"0",TCL_STATIC);
					#endif
					return TCL_OK;
				case 'p': case 'P':
					if (N!=1) {
						Tcl_ResetResult(intr);
						Tcl_AppendResult(intr,"usage: wyrm::io dprintf <string>",0);
						return TCL_ERROR;
					}
					dprintf("%{y}s",*P);
					return TCL_OK;
				default:
					goto unknown;
			}
		case 'e': case 'E':
			if (N!=1) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: wyrm::io eval <command>",0);
				return TCL_ERROR;
			}
			rprintf(intr,"%$[%{y}s]",*P);
			return TCL_OK;
		case 'r': case 'R': {
			long e;
			if (N!=1) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: wyrm::io require <n>",0);
				return TCL_ERROR;
			}
			if (Tcl_ExprLongObj(intr,*P,&e)!=TCL_OK) return TCL_ERROR;
			require(e);
		}	return TCL_OK;
		case 't': case 'T':
			if (N!=0) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: wyrm::io testing",0);
				return TCL_ERROR;
			}
			#ifdef TESTING
				Tcl_SetResult(intr,"1",TCL_STATIC);
			#else
				Tcl_SetResult(intr,"0",TCL_STATIC);
			#endif
			return TCL_OK;
		default: unknown:
			Tcl_ResetResult(intr);
			Tcl_AppendResult(intr,"wyrm::io: unknown subcommand: ",p,0);
			return TCL_ERROR;
	}
	return TCL_OK;
}

<Tcl code interface to the message catalog>

int wyrm_IOCommandInit(Intr intr) {
	char package[] = "namespace eval ::wyrm {namespace export io}\n";
	Tcl_CreateObjCommand(intr,"::wyrm::io",wyrm_IOCommand,0,0);
	Tcl_CreateObjCommand(intr,"::wyrm::mc",wyrm_IOMCCommand,0,0);
	return Tcl_Eval(intr,package);
}
^
Defined at: 3.
Definition continued at: 123.
Implementation wyrm-io.c
 
 
section    top 
121. qio (1WY) ::

NAME

qio — wyrm-io testing.

synopsis

::wyrm::wif::qio error

::wyrm::wif::qio block

::wyrm::wif::qio read channel

::wyrm::wif::qio getc channel

::wyrm::wif::qio gets channel string

::wyrm::wif::qio geto channel

::wyrm::wif::qio write channel string

::wyrm::wif::qio putc channel char

::wyrm::wif::qio puts channel string

::wyrm::wif::qio puto channel string

::wyrm::wif::qio cprintf channel format -|ii|oo|dd|ss|iii|oio|did|sis|ri value value [ value ]

::wyrm::wif::qio oprintf format -|ii|oo|dd|ss|iii|oio|did|sis|ri value value [ value ]

::wyrm::wif::qio rprintf format -|ii|oo|dd|ss|iii|oio|did|sis|ri value value [ value ]

::wyrm::wif::qio dprintf format -|ii|oo|dd|ss|iii|oio|did|sis|ri value value [ value ]

::wyrm::wif::qio yformat format string

::wyrm::wif::qio oresult format string

description

The qio command provides a Tcl interface to test some internal I/O functions.

SEE ALSO

io (1WY), wyrm-io (4WY).
^
Manpage qio (1WY)
 
 
   ^
    

Testing interface

 
    
top 

#ifdef TESTING
	int wyrm_testIOCommandInit(Intr intr);
#endif
^
Defined at: 2.
Definition continued at: 125.
Interface wyrm-io.h
 
 
section    top 

#ifdef TESTING
	static Tcl_Channel channel(Intr intr,Obj name) {
		int mode;
		chars s = Tcl_GetStringFromObj(name,0);
		Tcl_Channel c = Tcl_GetChannel(intr,s,&mode);
		if (!c) {
			Tcl_ResetResult(intr);
			Tcl_AppendResult(intr,"unknown channel: ",s);
		}
		return c;
	}
	static void result(Intr intr,chars p,int n,int N) {
		switch (N) {
			case EOF:	Tcl_SetResult(intr,"<EOF>",TCL_STATIC); return;
			case BLK:	Tcl_SetResult(intr,"<BLK>",TCL_STATIC); return;
			case ERR:	Tcl_SetResult(intr,"<ERR>",TCL_STATIC); return;
			default:
				if (p)	{
					char B[20]; Obj o; sprintf(B,"<%d>",N);
					o = Tcl_NewStringObj(p,n<0 ? 0 : n);
					Tcl_AppendToObj(o,B,-1);
					Tcl_SetObjResult(intr,o);
				}else	Tcl_SetObjResult(intr,Tcl_NewIntObj(n));
				return;
		}
	}
	static void resulto(Intr intr,Obj p,int n) {
		switch (n) {
			case EOF:	Tcl_SetResult(intr,"<EOF>",TCL_STATIC); return;
			case BLK:	Tcl_SetResult(intr,"<BLK>",TCL_STATIC); return;
			case ERR:	Tcl_SetResult(intr,"<ERR>",TCL_STATIC); return;
			default:
				if (p)	{
					char B[20]; sprintf(B,"<%d>",n);
					p = Tcl_DuplicateObj(p);
					Tcl_AppendToObj(p,B,-1);
					Tcl_SetObjResult(intr,p);
				}else	Tcl_SetObjResult(intr,Tcl_NewIntObj(n));
				return;
		}
	}

	typedef union {
		int		i;
		double	d;
		Obj		o;
		chars	s;
		Intr	r;
	} Value;
	static long mv(Intr intr,Obj *P,int N,Value *x,Value *y,Value *z) {
		long mode = wyrm_stringToC(Tcl_GetStringFromObj(P[1],0));
		switch (mode) {
			case '-':
				break;
			case 'ii':
				if (Tcl_GetIntFromObj(intr,P[2],&x->i)!=TCL_OK) return 0;
				if (Tcl_GetIntFromObj(intr,P[3],&y->i)!=TCL_OK) return 0;
				break;
			case 'oo':
				x->o = P[2];
				y->o = P[3];
				break;
			case 'dd':
				if (Tcl_GetDoubleFromObj(intr,P[2],&x->d)!=TCL_OK) return 0;
				if (Tcl_GetDoubleFromObj(intr,P[3],&y->d)!=TCL_OK) return 0;
				break;
			case 'ss':
				x->s = Tcl_GetStringFromObj(P[2],0);
				y->s = Tcl_GetStringFromObj(P[3],0);
				break;
			case 'iii':
				if (Tcl_GetIntFromObj(intr,P[2],&x->i)!=TCL_OK) return 0;
				if (Tcl_GetIntFromObj(intr,P[3],&y->i)!=TCL_OK) return 0;
				if (Tcl_GetIntFromObj(intr,P[4],&z->i)!=TCL_OK) return 0;
				break;
			case 'oio':
				x->o = P[2];
				if (Tcl_GetIntFromObj(intr,P[3],&y->i)!=TCL_OK) return 0;
				z->o = P[4];
				break;
			case 'did':
				if (Tcl_GetDoubleFromObj(intr,P[2],&x->d)!=TCL_OK) return 0;
				if (Tcl_GetIntFromObj(intr,P[3],&y->i)!=TCL_OK) return 0;
				if (Tcl_GetDoubleFromObj(intr,P[4],&z->d)!=TCL_OK) return 0;
				break;
			case 'sis':
				x->s = Tcl_GetStringFromObj(P[2],0);
				if (Tcl_GetIntFromObj(intr,P[3],&y->i)!=TCL_OK) return 0;
				z->s = Tcl_GetStringFromObj(P[4],0);
				break;
			case 'ri':
				x->r = intr;
				Tcl_SetObjResult(intr,P[2]);
				if (Tcl_GetIntFromObj(intr,P[3],&y->i)!=TCL_OK) return 0;
				break;
			default:
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"unknown format mode: ",Tcl_GetStringFromObj(P[1],0),0);
				mode = 0;
				break;
		}
		return mode;
	}

	static int chanBlock(ptr context,int mode) {
		chars c = context;
		if (*c!='e') {
			*c = mode==TCL_MODE_BLOCKING ? 'b' : 'B';
		}
		return 0;
	}
	static int chanClose(ptr context,Intr intr) {
		dispose(context);
		return 0;
	}
	static int chanTransput(ptr context,chars buf,int size,int *ec) {
		chars c = context;
		switch (*c) {
			case 'e':
				*ec = EIO;
				break;
			case 'B':
				*ec = EAGAIN;
				break;
			case 'b':
				*c = 'e';
				return 0;
		}
		return -1;
	}
	static void chanWatch(ptr context,int mask) {
		return;
	}
	static int chanHandle(ptr context,int direction,ptr *handle) {
		*handle = context; return TCL_OK;
	}
	static Tcl_ChannelType SpecialChannel = {
		"qio-channel",(ClientData)chanBlock,chanClose,
		chanTransput,(Tcl_DriverOutputProc*)chanTransput,
		0,0,0,chanWatch,chanHandle
	};

	static int wyrm_testIOCommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
		Tcl_Channel	c; chars p; int n; Obj o; Value x,y,z;
		if (N<2) {
			Tcl_ResetResult(intr);
			Tcl_AppendResult(intr,"usage: qio <subcommand> ...",0);
			return TCL_ERROR;
		}
		P++,N--;
		p = Tcl_GetStringFromObj(*P,0); P++,N--;

		if (streq(p,"error") || streq(p,"block")) {
			static int K = 0; char name[20]; chars q;
			if (N!=0) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio error|block",0);
				return TCL_ERROR;
			}
			q = heap(char); *q = *p; sprintf(name,"qio%d",++K);
			c = Tcl_CreateChannel(&SpecialChannel,name,q,TCL_READABLE|TCL_WRITABLE);
			Tcl_RegisterChannel(intr,c);
			Tcl_SetChannelOption(intr,c,"-buffering","none");
			Tcl_SetResult(intr,Tcl_GetChannelName(c),TCL_VOLATILE);
		}else if (streq(p,"read")) {
			if (N!=2) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio read channel n",0);
				return TCL_ERROR;
			}
			c = channel(intr,P[0]); if (!c) return TCL_ERROR;
			if (Tcl_GetIntFromObj(intr,P[1],&n)!=TCL_OK) return TCL_ERROR;
			p = nheap(n,char); n = cread(c,p,n);
			result(intr,p,n,n); dispose(p);
		}else if (streq(p,"getc")) {
			char C;
			if (N!=1) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio getc channel",0);
				return TCL_ERROR;
			}
			c = channel(intr,P[0]); if (!c) return TCL_ERROR;
			n = cgetc(c); C = n; result(intr,&C,1,n);
		}else if (streq(p,"gets")) {
			if (N!=2) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio gets channel s",0);
				return TCL_ERROR;
			}
			c = channel(intr,P[0]); if (!c) return TCL_ERROR;
			o = incr(Tcl_DuplicateObj(P[1]));
			n = cgets(c,o); resulto(intr,o,n); decr(o);
		}else if (streq(p,"geto")) {
			if (N!=1) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio geto channel",0);
				return TCL_ERROR;
			}
			c = channel(intr,P[0]); if (!c) return TCL_ERROR;
			o = cgeto(c); resulto(intr,o,o ? 1 : EOF); decr(o);
		}else if (streq(p,"write")) {
			if (N!=3) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio write channel s n",0);
				return TCL_ERROR;
			}
			c = channel(intr,P[0]); if (!c) return TCL_ERROR;
			p = Tcl_GetStringFromObj(P[1],0);
			if (Tcl_GetIntFromObj(intr,P[2],&n)!=TCL_OK) return TCL_ERROR;
			n = cwrite(c,p,n);
			result(intr,0,n,n);
		}else if (streq(p,"putc")) {
			if (N!=2) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio putc channel c",0);
				return TCL_ERROR;
			}
			c = channel(intr,P[0]); if (!c) return TCL_ERROR;
			p = Tcl_GetStringFromObj(P[1],0);
			n = cputc(c,*p); result(intr,0,n,n);
		}else if (streq(p,"puts")) {
			if (N!=2) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio puts channel s",0);
				return TCL_ERROR;
			}
			c = channel(intr,P[0]); if (!c) return TCL_ERROR;
			p = Tcl_GetStringFromObj(P[1],0);
			n = cputs(c,p); result(intr,0,n,n);
		}else if (streq(p,"puto")) {
			if (N!=2) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio puto channel s",0);
				return TCL_ERROR;
			}
			c = channel(intr,P[0]); if (!c) return TCL_ERROR;
			n = cputo(c,P[1]); resulto(intr,0,n);
		}else if (streq(p,"cprintf")) {
			p = N>=3 ? Tcl_GetStringFromObj(P[2],0) : "";
			n = strlen(p);
			if (!(*p=='-' && N==3) && (n<2 || n>3 || N!=3+n)) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio cprintf channel format mode value value [value]",0);
				return TCL_ERROR;
			}
			c = channel(intr,P[0]); if (!c) return TCL_ERROR; P++,N--;
			switch (mv(intr,(Obj*)P,N,&x,&y,&z)) {
				case '-':	n = cprintf(c,Tcl_GetStringFromObj(*P,0)); break;
				case 'ii':	n = cprintf(c,Tcl_GetStringFromObj(*P,0),x.i,y.i); break;
				case 'oo':	n = cprintf(c,Tcl_GetStringFromObj(*P,0),x.o,y.o); break;
				case 'dd':	n = cprintf(c,Tcl_GetStringFromObj(*P,0),x.d,y.d); break;
				case 'ss':	n = cprintf(c,Tcl_GetStringFromObj(*P,0),x.s,y.s); break;
				case 'iii':	n = cprintf(c,Tcl_GetStringFromObj(*P,0),x.i,y.i,z.i); break;
				case 'oio':	n = cprintf(c,Tcl_GetStringFromObj(*P,0),x.o,y.i,z.o); break;
				case 'did':	n = cprintf(c,Tcl_GetStringFromObj(*P,0),x.d,y.i,z.d); break;
				case 'sis':	n = cprintf(c,Tcl_GetStringFromObj(*P,0),x.s,y.i,z.s); break;
				case 'ri':	n = cprintf(c,Tcl_GetStringFromObj(*P,0),x.r,y.i); break;
				default: return TCL_ERROR;
			}
			result(intr,0,n,n);
		}else if (streq(p,"oprintf")) {
			p = N>=2 ? Tcl_GetStringFromObj(P[1],0) : "";
			n = strlen(p);
			if (!(*p=='-' && N==2) && (n<2 || n>3 || N!=2+n)) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio oprintf format mode value value [value]",0);
				return TCL_ERROR;
			}
			switch (mv(intr,(Obj*)P,N,&x,&y,&z)) {
				case '-':	o = oprintf(Tcl_GetStringFromObj(*P,0)); break;
				case 'ii':	o = oprintf(Tcl_GetStringFromObj(*P,0),x.i,y.i); break;
				case 'oo':	o = oprintf(Tcl_GetStringFromObj(*P,0),x.o,y.o); break;
				case 'dd':	o = oprintf(Tcl_GetStringFromObj(*P,0),x.d,y.d); break;
				case 'ss':	o = oprintf(Tcl_GetStringFromObj(*P,0),x.s,y.s); break;
				case 'iii':	o = oprintf(Tcl_GetStringFromObj(*P,0),x.i,y.i,z.i); break;
				case 'oio':	o = oprintf(Tcl_GetStringFromObj(*P,0),x.o,y.i,z.o); break;
				case 'did':	o = oprintf(Tcl_GetStringFromObj(*P,0),x.d,y.i,z.d); break;
				case 'sis':	o = oprintf(Tcl_GetStringFromObj(*P,0),x.s,y.i,z.s); break;
				case 'ri':	o = oprintf(Tcl_GetStringFromObj(*P,0),x.r,y.i); break;
				default: return TCL_ERROR;
			}
			resulto(intr,o,o ? 1 : EOF); decr(o);
		}else if (streq(p,"rprintf")) {
			p = N>=2 ? Tcl_GetStringFromObj(P[1],0) : "";
			n = strlen(p);
			if (!(*p=='-' && N==2) && (n<2 || n>3 || N!=2+n)) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio rprintf format mode value value [value]",0);
				return TCL_ERROR;
			}
			switch (mv(intr,(Obj*)P,N,&x,&y,&z)) {
				case '-':	return rprintf(intr,Tcl_GetStringFromObj(*P,0)); break;
				case 'ii':	return rprintf(intr,Tcl_GetStringFromObj(*P,0),x.i,y.i);
				case 'oo':	return rprintf(intr,Tcl_GetStringFromObj(*P,0),x.o,y.o);
				case 'dd':	return rprintf(intr,Tcl_GetStringFromObj(*P,0),x.d,y.d);
				case 'ss':	return rprintf(intr,Tcl_GetStringFromObj(*P,0),x.s,y.s);
				case 'iii':	return rprintf(intr,Tcl_GetStringFromObj(*P,0),x.i,y.i,z.i);
				case 'oio':	return rprintf(intr,Tcl_GetStringFromObj(*P,0),x.o,y.i,z.o);
				case 'did':	return rprintf(intr,Tcl_GetStringFromObj(*P,0),x.d,y.i,z.d);
				case 'sis':	return rprintf(intr,Tcl_GetStringFromObj(*P,0),x.s,y.i,z.s);
				case 'ri':	return rprintf(intr,Tcl_GetStringFromObj(*P,0),x.r,y.i);
				default: return TCL_ERROR;
			}
		}else if (streq(p,"dprintf")) {
			p = N>=2 ? Tcl_GetStringFromObj(P[1],0) : "";
			n = strlen(p);
			if (!(*p=='-' && N==2) && (n<2 || n>3 || N!=2+n)) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio dprintf format mode value value [value]",0);
				return TCL_ERROR;
			}
			switch (mv(intr,(Obj*)P,N,&x,&y,&z)) {
				case '-':	dprintf(Tcl_GetStringFromObj(*P,0)); break;
				case 'ii':	dprintf(Tcl_GetStringFromObj(*P,0),x.i,y.i); break;
				case 'oo':	dprintf(Tcl_GetStringFromObj(*P,0),x.o,y.o); break;
				case 'dd':	dprintf(Tcl_GetStringFromObj(*P,0),x.d,y.d); break;
				case 'ss':	dprintf(Tcl_GetStringFromObj(*P,0),x.s,y.s); break;
				case 'iii':	dprintf(Tcl_GetStringFromObj(*P,0),x.i,y.i,z.i); break;
				case 'oio':	dprintf(Tcl_GetStringFromObj(*P,0),x.o,y.i,z.o); break;
				case 'did':	dprintf(Tcl_GetStringFromObj(*P,0),x.d,y.i,z.d); break;
				case 'sis':	dprintf(Tcl_GetStringFromObj(*P,0),x.s,y.i,z.s); break;
				case 'ri':	dprintf(Tcl_GetStringFromObj(*P,0),x.r,y.i); break;
				default: return TCL_ERROR;
			}
		}else if (streq(p,"yformat")) {
			int pre,post; char R[40];
			if (N!=2) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio yformat format string",0);
				return TCL_ERROR;
			}
			incr(P[1]); pre = P[1]->refCount;
			decr(oprintf(Tcl_GetStringFromObj(P[0],0),P[1]));
			post = P[1]->refCount;
			if (pre==post) decr(P[1]);
			sprintf(R,"%d %d",pre,post); Tcl_SetResult(intr,R,TCL_VOLATILE);
		}else if (streq(p,"oresult")) {
			if (N!=2) {
				Tcl_ResetResult(intr);
				Tcl_AppendResult(intr,"usage: qio oresult format string",0);
				return TCL_ERROR;
			}
			o = oprintf(Tcl_GetStringFromObj(P[0],0),P[1]);
			Tcl_SetObjResult(intr,Tcl_NewIntObj(o->refCount));
			decr(o);
		}else {
			Tcl_ResetResult(intr);
			Tcl_AppendResult(intr,"qio: unknown subcommand: ",p,0);
			return TCL_ERROR;
		}
		return TCL_OK;
	}

	int wyrm_testIOCommandInit(Intr intr) {
		Tcl_CreateObjCommand(intr,"::wyrm::wif::qio",wyrm_testIOCommand,0,0);
		return TCL_OK;
	}
#endif
^
Defined at: 3.
Implementation wyrm-io.c
 
 
section    top 
^
Testbase wyrm-io.test
 
 
section    top 
#endif
^
Defined at: 2.
Interface wyrm-io.h
 
 
   ^