'-----------------------------------------------------------------------
' define abcd
' obj abcd.xyz
' include abcd.xyz
'
'
'-----------------------------------------------------------------------
#include "vbcompat.bi"

'-----------------------------------------------------------------------
Const max_dio = 1023

dim define_stack(0 to max_dio, 0 to 1) as string

dim obj_stack(0 to max_dio, 0 to 1) as string

dim block 	as integer
dim kommentar	as integer
dim new_obj	as boolean
dim def_block   as integer

dim f_file_x 	as integer
dim f_file_1 	as integer

dim as string  a_s, b_s, c_s, d_s 
dim as integer a_i, b_i, c_i, d_i, x_i, y_i, z_i
'-----------------------------------------------------------------------
'cls
Print "PreePro 0.0 by PIC18F2550"
Print "Compile Date: " & __DATE__
If Len(Command(1)) = 0 Then
	Print "(keine Start Datei angegeben)"
	end
End If
'-----------------------------------------------------------------------
' Neue elemente suchen
'-----------------------------------------------------------------------
close
dim pass as integer
pass		= 0
kommentar	= 0
a_s		= ""

obj_stack(0,0)		= Command(1)	'main_file
obj_stack(0,1)		= "obj"		'main_file immer eine Spindatei daher Objekt

f_file_x		= FreeFile
open "trace.tmp" for output as f_file_x

'-----------------------------------------------------------------------
do
	pass = pass + 1
	new_obj	= false
	print "Pass : "; pass
	print #f_file_x, "Pass : "; pass
	for z_i = 0 to max_dio
		f_file_1		= FreeFile
		if obj_stack(z_i,0) = "" then
			goto m101
		end if
		If FileExists(obj_stack(z_i,0) ) Then
			print , "open: " & obj_stack(z_i,0), obj_stack(z_i, 1),
			print #f_file_x, "open: " & obj_stack(z_i,0), obj_stack(z_i, 1),
		Else
			print z_i, "open: " & obj_stack(z_i,0) & " File not found!"
			print #f_file_x, "open: " & obj_stack(z_i,0) & " File not found!"
			goto m900
		end if
		open obj_stack(z_i,0) for input as f_file_1
			y_i=0
			block		= 0
			def_block       = 0

			if kommentar <> 0 then
				print z_i, "Fehler in {{}}} Strucktur!"
				print #f_file_x, "Fehler in {{}}} Strucktur!"
				goto m900
			end if

			do until eof(f_file_1)
				line input #f_file_1, a_s
				y_i= y_i + 1
				if y_i = 1 then		
					' EF BB BF steht für UTF-8
					if asc(mid$(a_s, 1, 1 )) = 239 and asc(mid$(a_s, 2, 1 )) = 187 and asc(mid$(a_s, 3, 1 )) = 191 then
						print 		 " <UTF8>"
						print #f_file_x, " <UTF8>" 
						a_s = mid$(a_s, 4)
						goto m099
					end if

					' FF FE steht für UTF-16, little endian
					if asc(mid$(a_s, 1, 1 )) = 255 and asc(mid$(a_s, 2, 1 )) = 254 then
						print 		 " <UTF-16, little endian>"
						print #f_file_x, " <UTF-16, little endian>" 
						a_s = mid$(a_s, 3)
						goto m099
					end if

					print " <ASCII>"
					print #f_file_x, " <ASCII>"
M099:				end if
'--------------------------------------------------------------------------------
				if len(a_s) = 0 then goto m100	'leerzeile überspringen
	
'--------------------------------------------------------------------------------
				a_i = instr(a_s,"'")
				if a_i = 1 then goto m100	'REM zeile überspringen
				a_s = mid$(a_s, 1, a_i - 1)	'REM abschneiden
	
'--------------------------------------------------------------------------------
				if instr(ucase(a_s),"{{") = 1 then kommentar = kommentar + 1
				if instr(ucase(a_s),"}}") = 1 then 
					if kommentar > 0 then
						kommentar = kommentar - 1
						goto m100
					else
						print "ERROR {{ fehlt."
						Print #f_file_x, "ERROR {{ fehlt."
						goto m900
					end if
				end if
				if kommentar > 0 then goto m100
'--------------------------------------------------------------------------------
				a_s = rtrim(a_s)
	
'--------------------------------------------------------------------------------
				if instr(ucase(a_s),"CON") = 1 then block = 1
				if instr(ucase(a_s),"DAT") = 1 then block = 2
				if instr(ucase(a_s),"OBJ") = 1 then block = 3 : goto m100
				if instr(ucase(a_s),"VAR") = 1 then block = 4
				if instr(ucase(a_s),"PUB") = 1 then block = 5
				if instr(ucase(a_s),"PRI") = 1 then block = 6
	
'--------------------------------------------------------------------------------
				if def_block = 0 and instr(ucase(a_s),"#IFDEF") = 1 then
						a_s = ucase(trim(mid$(a_s, 7)))
						for x_i = 0 to max_dio
							if define_stack(x_i, 0) = a_s then
								define_stack(x_i, 1) = "X"	' benutzt
								def_block = 0
								goto m100
							end if
						next x_i
						def_block = 1
						goto m100				        ' Überspringen da nicht deffiniert
				end if
'--------------------------------------------------------------------------------
				if instr(ucase(a_s),"#ENDIF") = 1 then
					if def_block = 1 then def_block = 0	' Überspringen da nicht deffiniert
					goto m100				        
				end if

'--------------------------------------------------------------------------------
				if def_block = 1 then goto m100				        ' Überspringen da nicht deffiniert

'--------------------------------------------------------------------------------

				if instr(ucase(a_s),"#DEFINE") = 1 then
					a_s = ucase(trim(mid$(a_s, 8)))
					for x_i = 0 to max_dio
						if define_stack(x_i, 0) = a_S then goto m100
						if define_stack(x_i, 0) = "" then
							define_stack(x_i, 0) = a_s
							x_i = max_dio + 1
							new_obj	= true
							goto m100
						end if
					next x_i
				end if
	
'--------------------------------------------------------------------------------
				if instr(ucase(a_s),"#INCLUDE") = 1 then
					a_s = trim(mid$(a_s, 9))
					for x_i = 0 to max_dio
						if obj_stack(x_i,0) = a_S then goto m100
						if obj_stack(x_i,0) = "" then
							obj_stack(x_i,0) = a_S
							obj_stack(x_i,1) = "inc"
							x_i = max_dio + 1
							new_obj	= true
							goto m100
						end if
					next x_i
				end if
	
'--------------------------------------------------------------------------------
				if block = 3 then	'Objekte einlesen
					a_s = trim(a_s)
					a_s = mid$(a_s,instr(a_s, ":") + 1)
					a_s = trim(a_s)
					for x_i = 0 to max_dio
						if obj_stack(x_i,0) = a_S then goto m100
						if obj_stack(x_i,0) = "" then
							obj_stack(x_i,0) = a_S
							obj_stack(x_i,1) = "obj"
							x_i = max_dio + 1
							new_obj	= true
						end if
					next x_i
				end if
	
'--------------------------------------------------------------------------------
				print #f_file_x, block;">", a_s
	
'--------------------------------------------------------------------------------
m100:
			loop
		close f_file_1
		sleep 100				' 1/10 Secunde warten
	
'-----------------------------------------------------------------------
	next
m101:
loop Until (new_obj = false)	' Verlassen wenn keine neuen Elemente gefunden.
print "Ready"
print #f_file_x, "Ready"

'-----------------------------------------------------------------------
' Stackausgeben
M900:
print #f_file_x,"--- Defines -------------------------------------------"
For a_i = 0 to max_dio
	if define_stack(a_i,0) <> "" then print #f_file_x, define_stack(a_i,0), define_stack(a_i,1)
next a_i

print #f_file_x,"--- Includes / OBJ ------------------------------------"
For a_i = 0 to max_dio
	if obj_stack(a_i,0) <> "" then print #f_file_x, obj_stack(a_i,0), " ";obj_stack(a_i,1)
next a_i

close f_file_x
print "press key to exit."
input ">", a_s
end 0