
uses 
sysutils

TYPE
FDATAB = RECORD
data : String[200]
next : Byte
end
FHEAD = RECORD
name 	: String[50]
exch    : String[50]
wo	: Integer
end

VAR
libdata		: ARRAY[0..2500] of FDATAB
libid		: ARRAY[0..2500] of FHEAD
filename	: Ansistring
libname		: Ansistring
dummy,temp      : Ansistring
fhlb,fhid	: Integer
fhcode          : Text

{Aufruf: lib01 FunctCodeFile LIBname}
BEGIN

libname = Paramstr(2)
WHEN (Paramstr(1) = '') OR (Paramstr(1) = UpCase('-H')) OR (Paramstr(1) = UpCase('HELP')) OR (Paramstr(1) = UpCase('-HELP')) THEN
	? '-----------------------------------------------------------------------'
	? 'mlib <Function-/Procedure- Sourefile> <libname> [-new]'
	?
	? 'The Option -new overwrites an existing Library with the same name.'
	?
	? '1. Param: Function/Procedure Sourcefile'
	? '2. Param: Library Name'
	? '3. Param: Optional -new'
	?
	? 'Example: mlib myfunctions.txt MyLib new'
	? 'This generates a new Libfile with name: MyLib.lb and MyLib.id'
	? 'the Functions and Procedures are declared in the File: myfunctions.txt'
	? 'If a Library with the same name exists, then the Library is deleted and'
	? 'with the new Functions/Procedures replaced.'
	?
	? 'Example: mlib myf.bas NewLib'
	? 'If a Library with the name "NewLib" exists, then the new Functions/Procs'
	? 'are appended, else a new one is created.'
	? 'If no library name is given, the default name "mlibdummy" is used.'
	?
	? 'mlib is used to create a Library file for:'
	? 'BasPas the Basic to Pascal Compiler'
	? 'Written by Andrea Tobian-Mezger 2003'
	?
	? 'More files and infos in: http://groups.yahoo.com/group/BasPas' 
	? '_________________________________________________________________________'
	halt(0)
OR WHEN (UpCase(Paramstr(2)) = '-NEW') or (Paramstr(2) = '') THEN
	filename = Paramstr(1)
	libname = 'mlibdummy'
	BPclearlib
OR WHEN Paramstr(3) = ''
	filename = Paramstr(1)
	libname = Paramstr(2)
	BPclearlib
	Loadlib(libname)
OR WHEN (UpCase(Paramstr(3)) = '-NEW') or (UpCase(Paramstr(3)) = 'NEW')
	filename = Paramstr(1)
	libname = Paramstr(2)
	BPclearlib
ELSE WHEN
	HALT(1)
END WHEN


PutFuPs(filename)
SaveLib(libname)




{Macroname,HeaderString für Indexfile + Gesammtstring der Func oder Proc}
Procedure putlib(macin,hdname,dbstr : String)
VAR
i,j,mk   : Integer
BEGIN
mk = 0

For i = 0 to 2500
    IF libid[i].name = '' THEN
        hdname = Trim(hdname)    

        libid[i].name = hdname
        libid[i].exch = UpCase(macin)
        For j = 0 to 2500
            IF libdata[j].data = '' THEN
                IF mk = 0 THEN
                    libid[i].wo = j
                    mk = 1
                END IF 
		IF j > 2480 then
			? 'WARNING: Blocknumer: ',j,' from 2500 is reached'
			? 'The Library is nearly full!'
		End IF	
                IF Length(dbstr) > 200 THEN
                    libdata[j].data = LeftStr(dbstr,200)
                    Delete(dbstr,1,200)
                    libdata[j].next = 1
                ELSE
                    libdata[j].data = dbstr
                    libdata[j].next = 0
                    BREAK
                END IF
            END IF
        Next j
        BREAK
    END IF
Next i
END PROC


{filename in der die Funktionen und Proceduren enthalten sind}
Procedure PutFuPs(fname : String)
VAR
isin        : Integer
tempdat,temphd,tempmac  : Ansistring
begin
isin = 0
OpenRead(fhcode,fname)
While not eof(fhcode)
    Readln(fhcode,temp)
    	temp = Trim(temp)
	IF Length(temp) > 1 THEN
        dummy = Trim(UpCase(temp))
	    WHEN (LeftStr(dummy,9) = 'FUNCTION ') THEN
                tempdat = temp + chr(13) + chr(10)
		DELETE(temp,1,9)
                temphd = Trim(Extract(temp,'('))
		IF temphd = '' THEN
		 temphd = Trim(temp)
		END IF 
                isin = 1
		tempmac = ''
	    OR WHEN (LeftStr(dummy,10) = 'PROCEDURE ') THEN
                tempdat = temp + chr(13) + chr(10)
		DELETE(temp,1,10)
                temphd = Trim(Extract(temp,'('))
		IF temphd = '' THEN
		 temphd = Trim(temp)
		END IF 		
                isin = 1
		tempmac = ''
            OR WHEN (LeftStr(dummy,8) = 'EXMACRO ') and (isin = 1) THEN
                DELETE(dummy,1,8)
                tempmac = Trim(dummy)
            OR WHEN (dummy = 'END PROC') or (dummy = 'ENDPROC') or (dummy = 'END PROCEDURE') or (dummy = 'END FUNC') or (dummy = 'ENDFUNC') or (dummy = 'END FUNCTION')
                tempdat = tempdat+temp+ chr(13) + chr(10)
                isin = 0
		IF tempmac = '' THEN
			tempmac = UpCase(temphd)
		END IF
		IF (Length(tempmac) > 50) OR (Length(temphd) > 50) THEN
			? 'ERROR Function or Procedure name too long'
		ELSE	
                	putlib(tempmac,temphd,tempdat)
		END IF	
            OR WHEN isin = 1  THEN    
                tempdat = tempdat+temp+ chr(13) + chr(10)
	    END WHEN
          END IF  
Wend    
Close(fhcode)
END Proc


Procedure SaveLib(thelib : String)
begin
fhid = FileCreate(thelib+'.id')
	FileWrite(fhid,libid,sizeof(libid))
FileClose(fhid)
fhlb = FileCreate(thelib+'.lb')
	FileWrite(fhlb,libdata,sizeof(libdata))
FileClose(fhlb)	
END PROC

Procedure LoadLib(thelib : String)
begin
fhid = FileOpen(thelib+'.id',fmOpenRead)
	FileRead(fhid,libid,sizeof(libid))
FileClose(fhid)
fhlb = FileOpen(thelib+'.lb',fmOpenRead)
	FileRead(fhlb,libdata,sizeof(libdata))
FileClose(fhlb)	
END PROC

END.
