// this source can be compiler with at least version 0.15 of PowerD (10.5.2000 or newer)

// todo:
// enum

OPT	OPTIMIZE=$ffff.ffff

MODULE	'exec/memory'

RAISE	"^C"  IF CtrlC()=TRUE,
		"MEM" IF AllocPooled()=NIL,
		"MEM" IF AllocVecPooled()=NIL

ENUM	SOURCE,NOCOMMENT
SET	F_NOCOMMENT

DEF	pool,flags=0

PROC main()
	DEF	args:PTR TO LONG,ra,
			name[256]:STRING,dest[256]:STRING,
			src:PTR TO CHAR,l,f=NIL,data
	args:=[NIL,FALSE]:LONG
	IF (ra:=ReadArgs('SOURCE/A,NC=NOCOMMENT/S',args,NIL))=NIL THEN Raise("DOS")
	StringF(name,'\s.h',args[SOURCE])
	StringF(dest,'\s.m',args[SOURCE])
	IF args[NOCOMMENT] THEN flags:=F_NOCOMMENT
	IF (l:=FileLength(name))<=0 THEN Raise("DOS")
	IFN pool:=CreatePool(MEMF_PUBLIC|MEMF_CLEAR,16384,4096) THEN Raise("MEM")
	src:=AllocVecPooled(pool,l+16)
	IF f:=Open(name,OLDFILE)
		Read(f,src,l)
		Close(f)
		f:=NIL
		data:=ReadC(src,l)
	ELSE
		Raise("DOS")
	ENDIF
	IF f:=Open(dest,NEWFILE)
		WriteD(f,data)
		VFPrintF(f,'\n',NIL)
		Close(f)
		f:=NIL
	ELSE
		Raise("DOS")
	ENDIF
EXCEPTDO
	SELECT exception
	CASE "DOS";	PrintFault(IOErr(),'h2m')
	CASE "MEM";	PrintF('\s: not enough memory\n','h2m')
	CASE "EOF";	PrintF('\s: unexpected eof (\d)\n','h2m',exceptioninfo)
	CASE "^C";	PrintF('\s: ***break \s\n','h2m',exceptioninfo)
	CASE "TYP";	PrintF('\s: unknown type (\d)\n','h2m',exceptioninfo)
	CASE "PTR";	PrintF('\s: too deep pointer (\d)\n','h2m',exceptioninfo)
	CASE "STX";	PrintF('\s: syntax error (\d)\n','h2m',exceptioninfo)
	ENDSELECT
	IF f THEN Close(f)
	IF pool THEN DeletePool(pool)
	IF ra THEN FreeArgs(ra)
ENDPROC

OBJECT data
	what:WORD,			// DA...
	next:PTR TO macro

ENUM	DA_None,
		DA_Comment,
		DA_OBJECT,
		DA_UNION,
		DA_ITEM,
		DA_ENUM,
		DA_Macro

OBJECT comment OF data
	comment:PTR TO CHAR

OBJECT obj OF data
	name:PTR TO CHAR,
	comment:PTR TO comment,
	item:PTR TO item

OBJECT item OF data
	name:PTR TO CHAR,
	comment:PTR TO comment,
	type:UBYTE,				// DT...
	flags:UBYTE,			// IF...
	size:LONG,
	obj:PTR TO CHAR		// obj/NIL

SET	IF_UNION						// item is an UNION

ENUM	DT_VOID,						// cut from dc.e
		DT_LONG,
		DT_ULONG,
		DT_WORD,
		DT_UWORD,
		DT_BYTE,
		DT_UBYTE,
		DT_FLOAT,
		DT_DOUBLE,
		DT_BOOL,
		DT_CUSTOM,					-> object - global field
		DT_PTR,						-> VOID pointer
		DT_DLONG,
		DT_UDLONG,
		DT_STRING,
		DT_BASE

OBJECT macro OF data
	type:WORD,
	name:PTR TO CHAR,
	args:PTR TO CHAR,
	comment:PTR TO CHAR,
	mline:PTR TO mline

ENUM	MT_define,
		MT_include,
		MT_ifdef,
		MT_ifndef,
		MT_endif

OBJECT mline
	next:PTR TO mline,
	data:PTR TO CHAR,
	comment:PTR TO CHAR

PROC ReadC(src:PTR TO CHAR,l)
	DEF	last=NIL:PTR TO data,frst=NIL:PTR TO data,pos=0,
			data:PTR TO data,name[80]:CHAR
	WHILE pos<l
		data:=NIL
		pos:=Crop(src,pos,l)
		IF (src[pos]="/"&&src[pos+1]="/")||(src[pos]="/"&&src[pos+1]="*")
			pos,data:=Comment(src,pos,l)
		ELSEIF src[pos]="#"
			pos,data:=Macro(src,pos,l)
		ELSE
			pos:=GetName(name,src,pos,l)
			IF StrCmp(name,'struct')
				pos,data:=OBJECT(src,pos,l)
//			ELSEIF StrCmp(name,'enum')
//				pos,data:=ENUM(src,pos,l)
			ELSE
				pos++
			ENDIF
			name[0]:="\0"
		ENDIF
		IFN frst THEN frst:=data
		IF  last THEN last.next:=data
		IF  data THEN last:=data
		WHILE last.next DO last:=.next
		CtrlC()
		IF CtrlD() THEN RETURN frst
	EXITIF src[pos]="\0"
	ENDWHILE
ENDPROC frst

// read one or more comments if available
PROC Comment(src:PTR TO CHAR,pos,l)(LONG,PTR TO comment)
	DEF	opos=pos,comment=NIL:PTR TO comment,data:PTR TO CHAR,first=NIL:PTR TO comment,
			last=NIL:PTR TO comment
	WHILE src[pos]="/"&&src[pos+1]="/"
		WHILE src[pos]<>"\n"
			pos++
			CtrlC()
		ENDWHILE
	ELSEWHILE src[pos]="/"&&src[pos+1]="*"
		REPEAT
			pos++
			CtrlC()
		UNTIL src[pos]="*"&&src[pos+1]="/"
		pos+=2
	ALWAYS
		IFN flags&F_NOCOMMENT
			comment:=AllocPooled(pool,SIZEOF_comment)
			comment.what:=DA_Comment
			data:=AllocVecPooled(pool,pos-opos+4)
			StrCopy(data,src+opos,pos-opos)
			comment.comment:=data
//			PrintF('(\d) \s\n',opos,data)
			IFN first THEN first:=comment
			IF last THEN last.next:=comment
			last:=comment
		ENDIF
//		pos:=Crop(src,pos,l)
		opos:=pos
	ENDWHILE
ENDPROC pos,first

PROC OBJECT(src:PTR TO CHAR,pos,l,union=FALSE)(LONG,PTR TO obj)
	DEF	name[80]:CHAR,obj:PTR TO obj,next=TRUE,item:PTR TO item,type,objn:PTR TO CHAR,
			last=NIL:PTR TO item,ptr,opos
	obj:=AllocPooled(pool,SIZEOF_obj)
	IFN union
		obj.what:=DA_OBJECT
		pos:=Skip(src,pos,l)
		pos:=GetName(name,src,pos,l)
		obj.name:=AllocPooled(pool,StrLen(name)+4)
		StrCopy(obj.name,name)
		pos:=Crop(src,pos,l)
		pos,obj.comment:=Comment(src,pos,l)
	ENDIF
//	PrintF('(\d) \s\n',pos,obj.name)
	pos:=Skip(src,pos,l)
	IF src[pos]="{" THEN pos++ //ELSE Raise("STX",pos)
	WHILE next
		opos:=pos:=Skip(src,pos,l)
		pos:=GetName(name,src,pos,l)	// read type
//		PrintF('(\d) \s\n',pos,name)
		objn:=NIL
		next:=TRUE

		SELECT TRUE
		CASE StrCmp(name,'int'),StrCmp(name,'long'),StrCmp(name,'LONG')
												type:=DT_LONG
		CASE StrCmp(name,'ULONG');		type:=DT_ULONG
		CASE StrCmp(name,'WORD');		type:=DT_WORD
		CASE StrCmp(name,'UWORD');		type:=DT_UWORD
		CASE StrCmp(name,'BYTE');		type:=DT_BYTE
		CASE StrCmp(name,'UBYTE'),StrCmp(name,'char')
												type:=DT_UBYTE
		CASE StrCmp(name,'STRPTR');	type:=DT_UBYTE+%100000
		CASE StrCmp(name,'float');		type:=DT_FLOAT
		CASE StrCmp(name,'double');	type:=DT_DOUBLE
		CASE StrCmp(name,'APTR'),StrCmp(name,'BPTR'),StrCmp(name,'CPTR')
												type:=DT_PTR
		CASE StrCmp(name,'struct');	type:=DT_CUSTOM
			pos:=Skip(src,pos,l)
			IF src[pos]="{"
				pos,item:=OBJECT(src,pos,l,TRUE)
//				PrintF('(\d) \s\n',pos,item.name)
				IFN obj.item THEN obj.item:=item
				IF last THEN last.next:=item
				last:=item
				next:=FALSE
			ELSE
				pos:=GetName(name,src,pos,l)
				objn:=AllocPooled(pool,StrLen(name)+4)
				StrCopy(objn,name)
				pos:=Skip(src,pos,l)
			ENDIF
		CASE StrCmp(name,'union');		type:=DT_CUSTOM
			pos:=Skip(src,pos,l)
			IF src[pos]="{"
				pos,item:=OBJECT(src,pos,l,TRUE)
//				PrintF('(\d) \s\n',pos,item.name)
				IFN obj.item THEN obj.item:=item
				IF last THEN last.next:=item
				last:=item
				next:=FALSE
			ENDIF
		DEFAULT;								type:=DT_CUSTOM
			objn:=AllocPooled(pool,StrLen(name)+4)
			StrCopy(objn,name)
			pos:=Skip(src,pos,l)
//			Raise("TYP",opos)
		ENDSELECT

		// next is TRUE
		WHILE next
			pos:=Skip(src,pos,l)
			item:=AllocPooled(pool,SIZEOF_item)
			item.what:=DA_ITEM
			item.obj:=objn
			item.type:=type
			ptr:=0
			WHILE src[pos]="*" DO pos++;	ptr++
			IF ptr>4 THEN Raise("PTR",pos)
			item.type|=ptr<<5
			pos:=GetName(name,src,pos,l)
			item.name:=AllocPooled(pool,StrLen(name)+4)
			StrCopy(item.name,name)
//			PrintF('(\d) \s(\d)\n',pos,name,ptr)
			pos:=Crop(src,pos,l)
//			PrintF('(\d) \s\n',pos,name)
			IF src[pos]="["
//				PrintF('Yes\n')
				opos:=++pos
				pos:=Find("]",src,pos,l)
				StrCopy(name,src+opos,pos-opos)
				C2D(name)
				item.size:=AllocPooled(pool,StrLen(name)+4)
				StrCopy(item.size,name)
				pos++
			ENDIF
			pos:=Crop(src,pos,l)
			IF src[pos]=","
				next:=TRUE
				pos++
			ELSE
				next:=FALSE
			ENDIF
			pos:=Crop(src,pos,l)
			pos,item.comment:=Comment(src,pos,l)
			pos:=Skip(src,pos,l)
			IFN obj.item THEN obj.item:=item
			IF last THEN last.next:=item
			last:=item
			CtrlC()
		ENDWHILE
	EXITIF src[pos]="}" DO pos:=Crop(src,++pos,l)
		next:=TRUE
	ENDWHILE
	IF union
		obj.what:=DA_UNION
		pos:=Skip(src,pos,l)
		pos:=GetName(name,src,pos,l)
//		PrintF('(\d) \s\n',pos,name)
		obj.name:=AllocPooled(pool,StrLen(name)+4)
		StrCopy(obj.name,name)
		pos:=Crop(src,pos,l)
		pos,obj.comment:=Comment(src,pos,l)
	ENDIF
ENDPROC pos,obj

PROC Macro(src:PTR TO CHAR,pos,l)(LONG,PTR TO macro)
	DEF	opos,macro=NIL:PTR TO macro,name[80]:STRING,next,ml,
			line:PTR TO mline,last:PTR TO mline,buf[1024]:STRING,cpos
	macro:=AllocPooled(pool,SIZEOF_macro)
	macro.what:=DA_Macro
	pos:=Skip(src,pos,l)
	pos:=GetName(name,src,pos,l)
	IF StrCmp(name,'#define')
		macro.type:=MT_define
		pos:=Skip(src,pos,l)
		pos:=GetName(name,src,pos,l)
		macro.name:=AllocPooled(pool,StrLen(name)+4)
		StrCopy(macro.name,name)
		IF src[pos]="("
			opos:=pos
			pos:=Find(")",src,pos,l)
			macro.args:=AllocPooled(pool,pos-opos+4)
			StrCopy(macro.args,src+opos,pos-opos)
		ENDIF
		next:=TRUE
		last:=NIL
		WHILE next
			opos:=pos
			pos:=MaCrop(src,pos,l)
			line:=AllocPooled(pool,SIZEOF_mline)
			StrCopy(buf,src+opos,pos-opos)
			cpos:=C2D(buf)
			ml:=StrLen(buf)+1
			IF cpos<100000 THEN ml-=ml-cpos
			line.data:=AllocPooled(pool,ml+4)
			StrCopy(line.data,buf,ml-1)
//			PrintF('\s\n',line.data)
			IF src[pos]="\\"
				pos++
				next:=TRUE
				pos:=Crop(src,pos,l)
				pos,line.comment:=Comment(src,pos,l)
			ELSE
				next:=FALSE
				IF cpos<100000 THEN pos,line.comment:=Comment(src,opos+cpos,l)
				pos++				// skip "\n"
			ENDIF
			IFN macro.mline THEN macro.mline:=line
			IF last THEN last.next:=line
			last:=line
			CtrlC()
		ENDWHILE
	ELSEIF StrCmp(name,'#ifdef')
		macro.type:=MT_ifdef
		pos:=Skip(src,pos,l)
		pos:=GetName(name,src,pos,l)
		macro.name:=AllocPooled(pool,StrLen(name)+4)
		StrCopy(macro.name,name)
	ELSEIF StrCmp(name,'#ifndef')
		macro.type:=MT_ifndef
		pos:=Skip(src,pos,l)
		pos:=GetName(name,src,pos,l)
		macro.name:=AllocPooled(pool,StrLen(name)+4)
		StrCopy(macro.name,name)
	ELSEIF StrCmp(name,'#endif')
		macro.type:=MT_endif
	ELSEIF StrCmp(name,'#include')
		macro.type:=MT_include
		pos:=Skip(src,pos,l)
		IF src[pos]="\q"
			opos:=++pos
			WHILE src[pos]<>"\q" DO pos++
			buf[0]:="*"
			StrCopy(buf+1,src+opos,pos-opos)
		ELSEIF src[pos]="<"
			opos:=++pos
			WHILE src[pos]<>">" DO pos++
			StrCopy(buf,src+opos,pos-opos)
		ENDIF
		ml:=StrLen(buf)
		IF buf[ml-2]="."&&buf[ml-1]="h" THEN buf[ml-2]:="\0"
		macro.name:=AllocPooled(pool,ml+4)
		StrCopy(macro.name,buf)
		pos++				// skip "\q" or ">"
	ENDIF
ENDPROC pos,macro

// this function replaces: '->' to '.', '0x' to '$'
PROC C2D(src:PTR TO CHAR)(LONG)
	DEF	spos=0,dpos=0,l=StrLen(src),cpos=100000
	WHILE spos<l		// dpos is always smaller or equal then spos
		IF src[spos]="-"&&src[spos+1]=">"
			src[dpos]:="."
			spos++
		ELSEIF src[spos]="0"&&src[spos+1]="x"
			src[dpos]:="$"
			spos++
//		ELSEIF IsHex(src[spos])&&src[spos+1]="L"
		ELSEIF ((src[spos]>="0"&&src[spos]<="9")||(src[spos]>="A"&&src[spos]<="F")||(src[spos]>="a"&&src[spos]<="f"))&&src[spos+1]="L"
			src[dpos]:=src[spos]
			spos++
		ELSEIF src[spos]="\q"
			src[dpos]:="\a"
		ELSEIF src[spos]="\a"
			src[dpos]:="\q"
		ELSEIF src[spos]="%"
			src[dpos]:="\\"
		ELSEIF src[spos]="/"&&src[spos+1]="/"
			IF cpos=100000 THEN cpos:=spos
		ELSEIF src[spos]="/"&&src[spos+1]="*"
			IF cpos=100000 THEN cpos:=spos
		ELSE
			src[dpos]:=src[spos]
		ENDIF
		spos++
		dpos++
		CtrlC()
	ENDWHILE
	src[dpos]:="\0"
ENDPROC cpos			// position of comment

PROC WriteD(f,data:PTR TO macro)
	DEF	prev
	WHILE data
		prev:=data
		// this loop removes #ifndef and #endif lines from destination
		WHILE data.what=DA_Macro&&data.type=MT_ifndef
			DEF	next=data.next:PTR TO macro
			IF next
				IF next.what=DA_Macro&&next.type=MT_include
					IF next.next.what=DA_Macro&&next.next.type=MT_endif
						WriteMacro(f,next)
						IF next.next THEN IFN data:=next.next.next THEN RETURN
					ENDIF
				ENDIF
			ENDIF
		EXITIF prev=data
		ENDWHILE
		SELECT data.what
		CASE DA_Comment;	WriteComment(f,data)
		CASE DA_OBJECT;	WriteOBJECT(f,data)
		CASE DA_Macro;		WriteMacro(f,data)
		ENDSELECT
		data:=.next
		CtrlC()
	ENDWHILE
ENDPROC

PROC WriteComment(f,comment:PTR TO comment)
	FPrintF(f,'\s\n',comment.comment)
ENDPROC

PROC WriteOBJECT(f,obj:PTR TO obj,level=0)
	DEF	item:PTR TO item,maxl=0,l
	item:=obj.item
	// find maximal name length
//	WHILE item DO maxl:=Max(maxl,ItemLen(item));	item:=.next
	WHILE item DO IF (l:=ItemLen(item))>maxl THEN maxl:=l;	item:=.next

	IF obj.what=DA_UNION&&level>0 THEN FOR l:=1 TO level FPrintF(f,'\t', NIL)
	FPrintF(f,'\s \s',IF obj.what=DA_OBJECT THEN 'OBJECT' ELSE 'NEWUNION',obj.name)
	IF obj.comment
		l:=StrLen(item)+3
		WHILE l<maxl DO l++;	FPrintF(f,' ',NIL)
		WriteD(f,obj.comment)
	ELSE
		FPrintF(f,'\n',NIL)
	ENDIF

	item:=obj.item
	WHILE item
		IF item.what=DA_UNION
			WriteOBJECT(f,item,level+1)
		ELSE
			FOR l:=0 TO level FPrintF(f,'\t', NIL)
			FPrintF(f,'\s',item.name)
			IF item.size THEN FPrintF(f,'[\s]',item.size)
			FPrintF(f,':\s',TypeStr(item.type))
			IF item.obj THEN FPrintF(f,item.obj,NIL)
		ENDIF
		IF item.next THEN FPrintF(f,',',NIL)
		IF item.comment
			l:=ItemLen(item)
			l-=4
			IFN item.next THEN l--
			WHILE l<maxl DO l++;	FPrintF(f,' ',NIL)
			WriteD(f,item.comment)
		ELSE
			FPrintF(f,'\n',NIL)
		ENDIF
		item:=.next
		CtrlC()
	ENDWHILE
	IF obj.what=DA_UNION&&level>0 THEN FOR l:=1 TO level FPrintF(f,'\t', NIL)
	FPrintF(f,IF obj.what=DA_OBJECT THEN '\n' ELSE 'ENDUNION',obj.name)
ENDPROC

PROC WriteMacro(f,macro:PTR TO macro)
	SELECT macro.type
	CASE MT_define
		DEF	line:PTR TO mline
		FPrintF(f,'#define \s\s',macro.name,macro.args)
		line:=macro.mline
		WHILE line
			FPrintF(f,' \s',line.data)
			IF line.next THEN FPrintF(f,'\\',NIL)
			IF line.comment
				FPrintF(f,'\t',NIL)
				WriteD(f,line.comment)
			ELSE FPrintF(f,'\n',NIL)
			line:=.next
			CtrlC()
		ENDWHILE
	CASE MT_include
		IFN StrCmp(macro.name,'exec/types') THEN FPrintF(f,'MODULE\t''\s''\n',macro.name)
	CASE MT_ifdef
		FPrintF(f,'#ifdef \s\n',macro.name)
	CASE MT_ifndef
		FPrintF(f,'#ifndef \s\n',macro.name)
	CASE MT_endif
		FPrintF(f,'#endif\n',NIL)
	ENDSELECT
ENDPROC

PROC ItemLen(item:PTR TO item)
	DEF	l,ptr
	l:=StrLen(item.name)
	IF item.size THEN l+=StrLen(item.size)+2
	IF item.obj THEN l+=StrLen(item.obj)
	SELECT item.type&$1f										// add ':type'
	CASE DT_PTR;												l+=4
	CASE DT_LONG,DT_WORD,DT_BYTE,DT_BOOL,DT_VOID;	l+=5
	CASE DT_ULONG,DT_UWORD,DT_UBYTE,DT_FLOAT;			l+=6
	CASE DT_DOUBLE;											l+=7
	DEFAULT;														l++
	ENDSELECT
	ptr:=item.type>>5
	l+=ptr*7					// length of 'PTR TO '
ENDPROC l

PROC TypeStr(type)(PTR TO CHAR)
	DEF	str:PTR TO CHAR
	SELECT type
	CASE 1;	str:='LONG'
	CASE 2;	str:='ULONG'
	CASE 3;	str:='WORD'
	CASE 4;	str:='UWORD'
	CASE 5;	str:='BYTE'
	CASE 6;	str:='UBYTE'
	CASE 7;	str:='FLOAT'
	CASE 8;	str:='DOUBLE'
	CASE 9;	str:='BOOL'
	CASE 10;	str:=NIL
	CASE 11;	str:='PTR'
	CASE 12;	str:='DLONG'
	CASE 13;	str:='UDLONG'
	CASE 14;	str:='STRING'

	CASE 33;	str:='PTR TO LONG'
	CASE 34;	str:='PTR TO ULONG'
	CASE 35;	str:='PTR TO WORD'
	CASE 36;	str:='PTR TO UWORD'
	CASE 37;	str:='PTR TO BYTE'
	CASE 38;	str:='PTR TO UBYTE'
	CASE 39;	str:='PTR TO FLOAT'
	CASE 40;	str:='PTR TO DOUBLE'
	CASE 41;	str:='PTR TO BOOL'
	CASE 42;	str:='PTR TO '
	CASE 43;	str:='PTR TO PTR'
	CASE 44;	str:='PTR TO DLONG'
	CASE 45;	str:='PTR TO UDLONG'
	CASE 46;	str:='PTR TO CHAR'

	CASE 65;	str:='PTR TO PTR TO LONG'
	CASE 66;	str:='PTR TO PTR TO ULONG'
	CASE 67;	str:='PTR TO PTR TO WORD'
	CASE 68;	str:='PTR TO PTR TO UWORD'
	CASE 69;	str:='PTR TO PTR TO BYTE'
	CASE 70;	str:='PTR TO PTR TO UBYTE'
	CASE 71;	str:='PTR TO PTR TO FLOAT'
	CASE 72;	str:='PTR TO PTR TO DOUBLE'
	CASE 73;	str:='PTR TO PTR TO BOOL'
	CASE 74;	str:='PTR TO PTR TO '
	CASE 75;	str:='PTR TO PTR TO PTR'
	CASE 76;	str:='PTR TO PTR TO DLONG'
	CASE 77;	str:='PTR TO PTR TO UDLONG'
	CASE 78;	str:='PTR TO PTR TO CHAR'

	CASE 129;str:='LIST OF LONG'
	CASE 130;str:='LIST OF ULONG'
	CASE 131;str:='LIST OF WORD'
	CASE 132;str:='LIST OF UWORD'
	CASE 133;str:='LIST OF BYTE'
	CASE 134;str:='LIST OF UBYTE'
	CASE 135;str:='LIST OF FLOAT'
	CASE 136;str:='LIST OF DOUBLE'
	CASE 137;str:='LIST OF BOOL'
	CASE 138;str:='LIST OF '
	CASE 139;str:='LIST OF PTR'
	CASE 140;str:='LIST OF DLONG'
	CASE 141;str:='LIST OF UDLONG'
	CASE 142;str:='LIST OF CHAR'
	DEFAULT;	str:='VOID'
	ENDSELECT
ENDPROC str

PROC GetName(name:PTR TO CHAR,src:PTR TO CHAR,pos,length)
	DEF i=0
	IF IsAlpha(src[pos])
		WHILE IsAlphaNum(src[pos])
			name[i]:=src[pos]
			pos++
			i++
			CtrlC()
			IF pos>length THEN Raise("EOF",pos)
		ENDWHILE
		name[i]:="\0"
	ENDIF
ENDPROC pos,name

PROC GetString(str:PTR TO CHAR,src:PTR TO CHAR,pos,length)
	DEF i=0
	IF (src[pos]=34)||(src[pos]="<")
		pos++
		WHILE (src[pos]<>34)&&(src[pos]<>">")
			str[i]:=src[pos]
			pos++
			i++
			CtrlC()
			IF pos>length THEN Raise("EOF",pos)
		ENDWHILE
		str[i]:="\0"
		pos++				// skip ",>
	ENDIF
ENDPROC pos,str

PROC Find(char,src:PTR TO CHAR,pos,length)
	WHILE src[pos]<>char
		pos++
		CtrlC()
		IF pos>length THEN Raise("EOF",pos)
	ENDWHILE
ENDPROC pos

PROC IsAlpha(char) IS IF ((char>="A")&&(char<="Z"))||((char>="a")&&(char<="z"))||(char="_")||(char="#") THEN TRUE ELSE FALSE
PROC IsAlphaNum(char) IS IF ((char>="A")&&(char<="Z"))||((char>="a")&&(char<="z"))||(char="_")||((char>="0")&&(char<="9"))||(char="#") THEN TRUE ELSE FALSE
PROC IsFirstNum(char) IS IF ((char>="0")&&(char<="9"))||(char=".")||(char="$")||(char="%")||(char="-") THEN TRUE ELSE FALSE

// skip whitespaces and comments
PROC Skip(src:PTR TO CHAR,pos,length)
	DEF done=FALSE,char
	REPEAT
		char:=src[pos]
		IF char=" "
			pos++
		ELSEIF char="\t"
			pos++
		ELSEIF char=";"
			pos++
		ELSEIF char="\n"
			pos++
		ELSEIF char="/"
			IF src[pos+1]="*"
				pos++
				REPEAT
					pos++
					IF pos>length THEN RETURN pos
				UNTIL (src[pos-1]="*")&&(src[pos]="/")
				pos++
			ELSEIF src[pos+1]="/"
				pos++
				REPEAT
					pos++
					IF pos>length THEN RETURN pos
				UNTIL (src[pos]="\n")||((src[pos-1]="/")&&(src[pos]="/"))
				pos++
			ELSE
				done:=TRUE
			ENDIF
		ELSE
			done:=TRUE
		ENDIF
		IF pos>length THEN Raise("EOF",pos)
	UNTIL done=TRUE
ENDPROC pos

// skip whitespaces only
PROC Crop(src:PTR TO CHAR,pos,length)
	DEF done=FALSE,char
	REPEAT
		char:=src[pos]
		IF char=" "
			pos++
		ELSEIF char="\t"
			pos++
		ELSEIF char=";"
			pos++
		ELSEIF char="\n"
			pos++
		ELSE
			done:=TRUE
		ENDIF
		IF pos>length THEN Raise("EOF",pos)
	UNTIL done=TRUE
ENDPROC pos

PROC MaCrop(src:PTR TO CHAR,pos,length)
	DEF	cpos=-1,qpos=-1,apos=-1
	WHILE src[pos]<>"\n"
		IF src[pos]="/" AND src[pos+1]="/" THEN cpos:=0
		IF src[pos]="/" AND src[pos+1]="*" THEN cpos:=0
		IF src[pos]="*" AND src[pos+1]="/" THEN cpos:=-1
		IF src[pos]="\q" THEN qpos:=~qpos
		IF src[pos]="\a" THEN apos:=~apos
		IF src[pos]="\\" THEN IF cpos=-1 AND qpos=-1 AND apos=-1 THEN RETURN pos
		pos++
		IF pos>length THEN Raise("EOF",pos)
	ENDWHILE
ENDPROC pos