{* Header *******************************************************************
**                                                                         **
** Program     :  NAP (New ACE Preprocessor)                               **
** Author      :  Daniel Seifert <dseifert@hell1og.be.schule.de>           **
**                                                                         **
** Version     :  2                                                        **
** Revision    :  01                                                       **
**                                                                         **
** work done at:  02,04-07,14-17,23,28-29-March-1996                       **
**                28-April-1996                                            **
**                04,07,10-May-1996                                        **
**                19-20,23-30-June-1996                                    **
**                01-04,07,12,15-19,22-24,26-July-1996                     **
**                01-04,11,17,25,31-August-1996                            **
**                01-05,08,18,23-24-September-1996                         **
**                01-03-October-1996                                       **
** language    :  ACE Basic, V2.37                                         **
**                                                                         **
** description :  a preprocessor especially for ACE Basic                  **
**                                                                         **
** copyright   :  Daniel Seifert                                           **
** comment     :  read the manual for further details before 1st use       **
****************************************************************************}


DEFint a-Z

{* opt is used to save the options got from the CLI-line and Temp- **
** file contains the name of the temporary file whereas InFile and **
** Outfile specifies the files to read from or write to.           *}
STRING   opt SIZE 100
STRING   InFile,OutFile,TempFile SIZE 125
STRING   argument,token,value,object SIZE 100

{* These integers are used to mark different conditions which have **
** a default value that can be inversed by using the options.      *}
SHORTINT Remove_Structs,Remove_Comments,Remove_Defines,Const_Defines
SHORTINT Replace_Defines,Print_Errors,ShowTime,Tracing,Remove_Lines

' For buffer handling
LONGINT MaxBuffer,BufferPtrBase

' For list handling
ADDRESS defines,include,needed_structs,structures

' For file handling
ADDRESS PathPtr

{* This is the path and filename of the temporary file. I suspect  **
** T: to point to RAM:t. I hope that's the same with you.          *}
TempFile="t:NAP.temp"

{* In the following array the directory names to be searched thru  **
** for include files are stored.                                   *}
DIM STRING Path(9) SIZE 100
PathPtr=@Path(0)
Path(1)="ACEINCLUDE:"
Path(2)="ACE:"         {* This is only for compatibility with ACPP *}
Path(3)="ACE:Include/" {* but I expect it to get changed in ACEIN- *}
                       {* CLUDE: always                            *}

{* This array is used to save the different bases of the lists     *}
DIM ADDRESS StrucBase(3)

{* In the following array the beginnings and the sizes of the file **
** buffers will be stored.                                         *}
DIM ADDRESS BufferPtr(9,1)
BufferPtrBase=@BufferPtr(0,0)

' structure definition

STRUCT Node                           {* Node is from EXEC/NODES.H *}
 ADDRESS   ln_Succ
 ADDRESS   ln_Pred
 BYTE      ln_Type
 BYTE      ln_Pri
 ADDRESS   ln_Name
END STRUCT

STRUCT _List
 ADDRESS   lh_Head
 ADDRESS   lh_Tail
 ADDRESS   lh_TailPred
 BYTE      lh_Type
 BYTE      l_pad
END STRUCT

STRUCT StructNode
 ADDRESS   ln_Succ
 ADDRESS   ln_Pred
 BYTE      ln_Type
 BYTE      ln_Pri
 ADDRESS   ln_Name
 ADDRESS   member_types_list
END STRUCT

STRUCT DefineNode
 ADDRESS   ln_Succ
 ADDRESS   ln_Pred
 BYTE      ln_Type
 BYTE      ln_Pri
 ADDRESS   ln_Name
 ADDRESS   replace
 SHORTINT  countparam
END STRUCT

library dos
declare function xRead&(ADDRESS filehandle,ADDRESS buffer,longint bytes) library dos
declare function xWrite&(ADDRESS filehandle,ADDRESS buffer,longint bytes) library dos
declare function Seek&(ADDRESS filehandle,longint offset,longint modus) library dos

library exec
declare function Remove(ADDRESS nodeptr) library exec
declare function AddTail&(ADDRESS listptr,ADDRESS nodeptr) library exec
declare function FindName&(ADDRESS listptr,ADDRESS stringptr) library exec
declare function FreeMem&(ADDRESS memoryblock,longint bytesize) library exec
declare function AllocMem&(longint bytesize,longint requirements) library exec

' All these sub programs are in NAP_Mods.o to be linked with BLINK.
DECLARE SUB ADDRESS  Copy (STRING text) EXTERNAL
DECLARE SUB SHORTINT legal (STRING text,SHORTINT position) EXTERNAL
DECLARE SUB STRING   UpperCase$(STRING lowercase) EXTERNAL
DECLARE SUB STRING   CutOff (STRING text,SHORTINT FoundSth) EXTERNAL
DECLARE SUB SHORTINT Search2(SHORTINT start,STRING text,STRING snippet) EXTERNAL
DECLARE SUB STRING   Get_name_of_object (SHORTINT startpos, STRING text) EXTERNAL
DECLARE SUB STRING   Get_name_of_object_alt (SHORTINT startpos, STRING text) EXTERNAL
DECLARE SUB STRING   ReplaceC (STRING text,STRING toReplace,STRING replace) EXTERNAL
DECLARE SUB SINGLE   ParseExpr (STRING expression) EXTERNAL
DECLARE SUB STRING   lese(shortint filenumber,ADDRESS BufferPtrBase) EXTERNAL
DECLARE SUB          texts(shortint code) EXTERNAL

GOTO Start      {* The one and only GOTO in this program. I put it **
                ** here so that the compiled program mustn't jump  **
                ** from sub to end sub all the many subs. (It does **
                ** speed the whole thing a little bit up :)        *}

{ ----------------------------------------------------------------- }

{* ENDE closes all files and kills the temporary file.  It is used **
** when doing a CTRL-C or when NAP finishs.                        *}
SUB ende
 SHARED TempFile,OutFile,BufferPtrBase,Remove_Structs,Tracing
 DIM ADDRESS BufferPtr(9,1) ADDRESS BufferPtrBase

 FOR i=1 TO 9
  CLOSE #i
  IF BufferPtr(i,0) THEN call FreeMem&(BufferPtr(i,0),BufferPtr(i,1))
 NEXT

 CLEAR ALLOC
 IF TempFile<>OutFile THEN KILL TempFile
 STOP
END SUB


{* This routine prints an error message to standard output. There- **
** fore the Print_Errors variable must be set, otherwise the error **
** message would be suppressed.                                    *}
sub PrErr (shortint code,string text)
 shared Print_Errors

 IF Print_Errors THEN
  IF code=0 THEN ? "--ERROR : "text ELSE CALL texts(code)
 END IF
END sub

{* This sub program is made to replace the "PUT #" command. It is  **
** much faster and 100% compatible with the "PUT #" command !      *}
sub schreibe(STRING text)
 longint geschrieben,l

 l=LEN(text)
 poke @text+l,10
 ++l
 geschrieben=xWrite&(handle(1),@text,l)
 IF geschrieben<l THEN CALL PrErr (101,""):CALL ende
END SUB

{* ReplaceDefines - Checks every word within a string whether it's **
**                  a define and replaces it if necessary          **
**                                                                 **
**   Syntax : replaced = ReplaceDefines(defineslist,text)          **
**                                                                 **
**     replaced       : (string) <text> with every used define re- **
**                      placed                                     **
**     defineslist    : (address) pointer to the list of defines   **
**     text           : (string) string to be checked              *}

SUB STRING ReplaceDefines (ADDRESS defptr,STRING text)
 SHARED   Print_Errors
 STRING   object,replace,param
 SHORTINT cparam,found,foundsth,position
 DECLARE  STRUCT definenode *defines

 ++foundsth
 REPEAT
  object=get_name_of_object_alt(foundsth,text)
  foundsth=search2(foundsth,text,object)
  defines=FindName&(defptr,@object)
  IF defines THEN
   replace=cstr(defines->replace)
   ' Do we have to parse?
   IF defines->countparam THEN
    ' yes - look for begin of parameter list
    position=search2(foundsth,text,"(")
    IF position=0 THEN
     ' Funny. There have to be params but there are none :(
     PrErr (0,"Corrupt define "+cstr(defines->ln_name))
    ELSE
     cparam=0
     WHILE peek(@text+position-1)<>41        ' 41 = ")"
      param=get_name_of_object_alt(position,text)
      position=position+LEN(param)
      ++position
      ++cparam
      a$=chr$(cparam)
      found=search2(1,replace,a$)
      WHILE found
       ++found
       replace=LEFT$(replace,found-2)+param+MID$(replace,found)
       found=search2(found,replace,a$)
      WEND
     WEND
     ++position
    END IF
   ELSE
    position=foundsth+LEN(object)
   END IF
   text=LEFT$(text,foundsth-1)+replace+MID$(text,position)
   foundsth=foundsth+LEN(replace)
  else
   foundsth=foundsth+LEN(object)
  END IF
 until peek(@object)=0

 ReplaceDefines=text
END sub

{* This routine replaces C-comments (/* and */) through ACE ones   **
** and checks whether there is a define                            *}
SUB STRING Convert (STRING text,ADDRESS defptr)
 SHARED Replace_Defines
 DECLARE STRUCT definenode *defines

 SHORTINT foundsth,position,cparam,found
 STRING   replace,param,object

 {* Why should we waste time by using this sub program if the      **
 ** string is empty ?                                              *}
 IF peek(@text)=0 THEN Convert="":exit sub

 {* You must first replace */ and then /*.  This is very important **
 ** and not paying attention to that would lead to a processed co- **
 ** de where all comments begin with { but do end with a */. This  **
 ** has to do with the Legal-routine which's used to check whether **
 ** "/*" or "*/" is within a string or a comment.                  *}
 text=ReplaceC(text,"*/","}")
 text=ReplaceC(text,"/*","{")

 {* If we are allowed to replace defines within the source code we **
 ** check every word within the line if it's a defined alias. Here **
 ** one can make things like removing all  PRINT  commands through **
 ** the faster PRINTS command  (if the program just uses intuition **
 ** windows)                                                       **
 ** Note: Defines have a higher priority than the commands of the  **
 **       programming language since NAP just checks whether there **
 **       is something defined within the string but does not care **
 **       of removing real commands!                               **
 **       A good example is again GadTools.b. The last line is     **
 **                LIBRARY CLOSE                                   **
 **       which will look like "LIBRARY   &H00800" after prepro-   **
 **       cessing it with NAP : somewhere must have been a #define **
 **       for CLOSE. Stupid, but what shall I do?                  *}

 IF Replace_Defines THEN text=ReplaceDefines(DefPtr,text)

 convert=text
END SUB

SUB ADDRESS ReserveMem (shortint filenumber)
 shared BufferPtrBase,MaxBuffer
 ADDRESS ActBuffer
 longint filesize

 DIM ADDRESS BufferPtr(9,1) ADDRESS BufferPtrBase

 filesize=seek&(handle(filenumber),0,1)
 filesize=seek&(handle(filenumber),0,-1)

 {* The filebuffer is as long as the b option specifies it, except **
 ** the file is shorter than the specified size. Then we are very  **
 ** flexible and the filebuffer is as long as the file, therefore  **
 ** we does not waste memory. BTW, if you have only less memory a  **
 ** buffersize of 4-5 or lower can help processing files without   **
 ** an "out of memory" failure.                                    *}

 IF filesize<MaxBuffer THEN filesize=filesize+5 else filesize=MaxBuffer+5
 ActBuffer=AllocMem&(fileSize,65536&)

 IF ActBuffer=0 THEN CALL PrErr(102,""):CALL ende

 BufferPtr(filenumber,0)=ActBuffer
 BufferPtr(filenumber,1)=filesize
 ReserveMem=ActBuffer+filesize-1
END SUB

{ ----------------------------------------------------------------- }

{* This sub program adds a specific file to the TempFile.          **
** Params :  filenumber  - next free filenumber                    **
**           filename    - name (incl path) of file to be included *}

SUB AddToTemp (SHORTINT filenumber,STRING filename)
 SHARED Const_Defines,Remove_Structs,Remove_Defines,Print_Errors
 SHARED MaxBuffer,Remove_Comments,BufferPtrBase,include,defines
 SHARED needed_structs,structures,PathPtr,Tracing,Remove_Lines

 DIM ADDRESS BufferPtr(9,1) ADDRESS BufferPtrBase
 DIM STRING Path(9) SIZE 100% ADDRESS PathPtr

 ON BREAK CALL ende
 BREAK ON

 STRING spaces SIZE 20
 spaces=STRING$(filenumber," ")
 IF tracing THEN ? spaces;filenumber;string$(15-filenumber," ");filename;" ..";

 FOR i=0 to 9
  open "I",filenumber,Path(i)+filename
  IF handle(filenumber) THEN exit for
 NEXT
 IF handle(filenumber)=0 THEN
  PrErr (0,"Could not open "+filename+"!")
  EXIT SUB
 END IF

 IF tracing THEN ? ".. ok"
 ADDRESS FileReady
 FileReady=ReserveMem(filenumber)

 STRING   object,toparse,fname,command,param,name_of_struct SIZE 200
 STRING   text,BigText,replace,precoms1,precoms2
 SHORTINT inComment,in_Struct,if_depth,valid_depth

 STRING definition size 10
 STRING declaration size 20
 STRING reserved size 55

 definition="STRUCT "
 declaration="DECLARE STRUCT "

 reserved=" LONGINT SHORTINT END STRUCT BYTE ADDRESS STRING    { } ' "
 precoms1=" IF UNDEF IFDEF IFNDEF "
 precoms2=" IF ELSE ELIF ENDIF DEFINE INCLUDE "

 DECLARE STRUCT _List *substruct
 DECLARE STRUCT Node *EmptyNode
 DECLARE STRUCT DefineNode *EmptyDefine
 DECLARE STRUCT StructNode *EmptyStruct

 WHILE peek(fileready)=0
  IF inComment THEN
   inComment=0
   REPEAT
    text=ReplaceC(lese(filenumber,bufferptrbase),"*/","}")
    foundsth=search2(1,text,"}")
    IF foundsth=0 THEN
     IF Remove_Comments=0 THEN
      schreibe(text)
     else
      IF RemoveLines=0 THEN
       schreibe(" ")
      END IF
     END IF
    else
     IF Remove_Comments=0 THEN call schreibe(left$(text,FoundSth))
     text=MID$(text,foundsth+1)
    END IF
   until foundsth
  else
   text=lese(filenumber,bufferptrbase)
  END IF

  {* 1st look for preprocessor commands.  These commands work with **
  ** tokens defined via #define. Therefore defines must not be re- **
  ** placed !                                                      *}

  ' is there a preprocessor command within this line?
  IF PEEK(@text)=35 THEN                 { 35 = "#" }
   BigText=UpperCase$(text)
   command=get_name_of_object(2,BigText)

   IF search2(1,precoms1,command+" ") THEN
    IF command="UNDEF" THEN
     ' what shall we undefine?
     object=get_name_of_object(8,text)
     emptydefine=FindName&(defines,@object)
     IF emptydefine=0 THEN
      PrErr (0,"Could not undefine "+object)
     else
      Remove&(emptydefine)
     END IF
    END IF

    {* This is for  "#IF DEFINED <token>"  commands. The other #IF  **
    ** variation can be found further down.                         *}
    IF command="IF" THEN                       ' <expression>
     object=get_name_of_object(5,BigText)
     IF object="DEFINED" THEN
      IF valid_depth=if_depth THEN
       found=search2(5,BigText,object)
       object=get_name_of_object_alt(found+8,text)
       IF FindName&(defines,@object) THEN ++valid_depth
      END IF
      ++if_depth
      {* Since we processed this variation of the "#IF" command, we **
      ** must prevent the other #IF-processing routine to process   **
      ** this one again. So we destroy it.                          *}
      command="UNDEF" 'has already been processed so don't care ;)
     END IF
    END IF

    IF command="IFDEF" or command="IFNDEF" THEN
     object=get_name_of_object_alt(8,text)
     if FindName&(defines,@object) then
      IF command="IFDEF" then ++valid_depth
     else
      if command="IFNDEF" then ++valid_depth
     end if
     ++if_depth
    end if
   END IF

   {* Now we test again of existing preprocessor commands. But this **
   ** time tokens must be replaced!                                 *}

   IF search2(1,precoms2,command+" ") THEN
    text=convert(text,defines)
    BigText=uppercase$(text)

    IF command="ELIF" THEN                      ' <expression>
     IF if_depth=valid_depth THEN
      IF if_depth=0 THEN
       PrErr(103,"")
      ELSE
       --valid_depth
      END IF
     ELSE
      IF valid_depth+1=if_depth THEN
       IF ParseExpr(MID$(text,7)) THEN ++valid_depth
      END IF
     END IF
    END IF

    IF command="ENDIF" THEN
     IF valid_depth=if_depth THEN --valid_depth
     --if_depth
     IF if_depth<0 THEN
      PrErr (104,"")
      if_depth=0
      valid_depth=0
     END IF
    END IF

    IF command="IF" THEN
     IF if_depth=valid_depth AND ParseExpr(MID$(text,5)) THEN ++valid_depth
     ++if_depth
    END IF

    IF command="ELSE" THEN
     IF if_depth=valid_depth THEN
      --valid_depth
     else
      if if_depth-1=valid_depth then ++valid_depth
     end if
    END IF

    IF command="INCLUDE" THEN
     fname=get_name_of_object(10,BigText)
     ' remove <brackets>
     fname=MID$(fname,2,LEN(fname)-2)

     ' file already included? If not, THEN
     IF FindName&(include,@fname)=0 THEN
      ' save include file name
      EmptyNode=ALLOC(sizeof(Node),7)
      EmptyNode->ln_name=Copy(fname)
      AddTail&(include,EmptyNode)

      ' include file
      AddToTemp(filenumber+1,fname)

      ' reset string contents
      definition="STRUCT "
      reserved=" LONGINT SHORTINT END STRUCT BYTE ADDRESS STRING    { } ' "
      command="definition
      declaration="DECLARE STRUCT "
      spaces=STRING$(filenumber," ")
     END IF
    END IF

    IF command="DEFINE" AND Remove_Defines=0 THEN
     EmptyDefine=ALLOC(sizeof(DefineNode),7)
     EmptyDefine->ln_name=Copy(get_name_of_object_alt(8,text))
     toparse=get_name_of_object(8,text)
     foundsth=search2(8,text,toparse)
     POKE @replace,0

     REPEAT
      IF peek(@replace)=0 THEN
       replace=MID$(text,foundsth+LEN(toparse))
      ELSE
       text=Convert(lese(filenumber,bufferptrbase),defines)
       replace=LEFT$(replace,LEN(replace)-1)+text
      END IF
      a$=RIGHT$(replace,1)
     UNTIL a$<>"\" AND a$<>"~"

     foundsth=search2(1,replace,"{")
     IF foundsth THEN
      while foundsth
       foundend=search2(1,replace,"}")
       IF foundend THEN
        ++foundend
        --foundsth
        replace=left$(replace,foundsth)+MID$(replace,foundend)
        foundsth=search2(1,replace,"{")
       else
        replace=left$(replace,foundsth-1)
        foundsth=0
       END IF
      wend
     else
      foundsth=search2(1,replace,"'")
      IF foundsth THEN replace=LEFT$(replace,foundsth-1)
     END IF

     cparam=0
     foundsth=search2(1,toparse,"(")

     IF foundsth THEN
      IF Const_Defines THEN
       PrErr (0,toparse+" is not legal when option Q is used !")
      ELSE
       length=LEN(toparse)
       WHILE peek(@toparse+foundsth-1)<>41 AND foundsth<Length
        param=get_name_of_object_alt(foundsth,toparse)
        foundsth=foundsth+LEN(param)
        ++foundsth
        ++cparam
        found=1
        REPEAT
         found=search2(found,replace,param)
        UNTIL param=get_name_of_object_alt(found-1,replace) or found=0
        IF found THEN replace=LEFT$(replace,found-1)+CHR$(cparam)+~
                              MID$(replace,found+LEN(param))
       WEND
      END IF
     END IF

     emptydefine->replace=Copy(replace)
     emptydefine->countparam=cparam

     IF Const_Defines THEN
      schreibe("CONST "+cstr(emptydefine->ln_name)+"="+STR$(VAL(replace)))
      IF cparam=0 THEN call AddTail&(defines,emptydefine)
     else
      AddTail&(defines,emptydefine)
     END IF
    END IF
   else
    if peek(@command) then
     if search2(1,precoms1,command+" ")=0 then call PrErr (0,"#"+command+" - unknown command")
    end if
   end if

   foundsth=search2(1,text,"{")
   IF foundsth THEN text=MID$(text,foundsth) else POKE @text,0

  ELSE

   IF if_depth>valid_depth THEN
    POKE @text,0
    POKE @BigText,0
   else
    text=convert(text,defines)
    BigText=uppercase$(text)
   END IF

   ' is there a structure definition?
   struct_def=search2(1,BigText,definition)

   If struct_def THEN
    struct_dec=search2(1,Bigtext,declaration)

    IF struct_dec THEN
     IF legal(text,struct_dec) and Remove_Structs THEN
      ' save name of declared structure in list
      EmptyNode=ALLOC(sizeof(node),7)
      emptynode->ln_name=copy(get_name_of_object(15+struct_dec,BigText))
      AddTail&(needed_structs,EmptyNode)
      IF Tracing THEN ? spaces;" found declaration for structure "cstr(emptynode->ln_name)
     END IF
    ELSE
     IF legal(text,struct_def) and in_Struct=0 THEN
      proceed=1
      IF struct_def>1 THEN
       IF get_name_of_object_alt(struct_def-1,text)<>definition THEN proceed=0
      END IF

      IF proceed THEN
       in_struct=1
       IF Remove_Structs THEN
        ' yes, it is -> save name of structure in list
        EmptyStruct=ALLOC(sizeof(structnode),7)
        EmptyStruct->ln_name=Copy(get_name_of_object(6+struct_def,Bigtext))
        EmptyStruct->member_types_list=ALLOC(SIZEOF(_list),7)
        substruct=emptystruct->member_types_list
        AddTail&(structures,EmptyStruct)
        IF Tracing THEN ? spaces;" found definition for structure "cstr(emptystruct->ln_name)
        substruct->lh_Head=substruct+4
        substruct->lh_TailPred=substruct
       END IF
      END IF
     END IF
    END IF
   END IF

   IF in_Struct=1 THEN
    ' name of substruct
    IF Const_Defines THEN text=ReplaceDefines(defines,text):BigText=UpperCase$(text)
    name_of_struct=get_name_of_object(1,BigText)
    IF name_of_struct="END" THEN
     in_Struct=0
    else
     IF Remove_Structs THEN
      IF search2(1,reserved," "+name_of_struct+" ")=0 THEN
       IF FindName&(substruct,name_of_struct)=0 THEN
        emptynode=ALLOC(sizeof(node),7)
        emptynode->ln_name=copy(name_of_struct)
        AddTail&(substruct,emptynode)
        IF Tracing THEN ? spaces;"   -> needed struct : "name_of_Struct
       END IF
      END IF
     END IF
    END IF
   END IF
  END IF

  ' REMOVE COMMENTS

  FoundSth=search2(1,text,"{")
  IF FoundSth THEN
   FoundEnd=search2(FoundSth,text,"}")
   IF FoundEnd THEN
    IF Remove_Comments THEN text=cutoff(text,FoundSth)+~
                                 RIGHT$(text,LEN(text)-FoundEnd)
   ELSE
    IF legal(text,foundsth) then
     --foundsth
     IF Remove_Comments THEN text=left$(text,FoundSth)
     inComment=1
    END IF
   END IF
  END IF

  IF Remove_Comments THEN
   FoundSth=search2(1,text,"'")
   IF FoundSth THEN text=cutoff(text,FoundSth)
   FoundSth=search2(1,UpperCase$(text),"REM ")
   IF FoundSth THEN text=cutoff(text,FoundSth)
  END IF

  IF LEN(text) or RemoveLines=0 THEN
   schreibe(text)
   KillEmpty=0
  ELSE
   IF KillEmpty=0 THEN
    schreibe(" ")
    ++KillEmpty
   END IF
  END IF
 WEND

 IF if_depth THEN CALL PrErr(105,"")
 IF Tracing THEN ? STRING$(filenumber," ");" finished"
 BREAK OFF
 CLOSE #filenumber
 FreeMem&(BufferPtr(filenumber,0),BufferPtr(filenumber,1))
 BufferPtr(filenumber,0)=0
END SUB

{ -------------------------------------------------------------------------- }

SUB RemoveStuff
 ' removes unused structs

 SHARED needed_structs,structures,BufferPtrBase,Tracing
 DIM ADDRESS BufferPtr(9,1) ADDRESS BufferPtrBase

 ADDRESS FileReady
 FileReady=ReserveMem(2)

 ON BREAK CALL ende
 BREAK ON

 STRING   object,text,definition,declaration SIZE 100
 STRING   name_of_struct,BigText SIZE 100
 SHORTINT in_Struct
 ADDRESS  next_node

 definition="STRUCT "
 declaration="DECLARE STRUCT "

 DECLARE STRUCT _List *structs,*substruct
 DECLARE STRUCT Node *EmptyNode
 DECLARE STRUCT StructNode *EmptyStruct

 if Tracing then call texts(5)
 structs=structures
 REPEAT
  EmptyStruct=structs->lh_Head
  FoundSth=0
  WHILE EmptyStruct->ln_Succ
   object=cstr(EmptyStruct->ln_name)
   IF FindName&(needed_structs,object) THEN
    substruct=emptystruct->member_types_list
    emptynode=substruct->lh_head
    WHILE emptynode->ln_succ
     object=cstr(emptynode->ln_name)
     next_node=emptynode->ln_succ
     IF FindName&(needed_structs,object)=0 THEN
      if tracing then ? "     add "object" to list of needed structures"
      AddTail&(needed_structs,emptynode)
      FoundSth=1
     END IF
     emptynode=next_node
    WEND
   END IF
   emptystruct=emptystruct->ln_succ
  WEND
 UNTIL FoundSth=0

 IF Tracing THEN
  ? "  Result:"
  structs=structures
  emptystruct=structs->lh_head
  WHILE emptystruct->ln_succ
   object=CSTR(emptystruct->ln_name)
   ? "     ";
   IF FindName&(needed_structs,object) THEN ? "need"; ELSE ? "remove";
   print " structure "object
   emptystruct=emptystruct->ln_succ
  WEND
 END IF

 WHILE peek(FileReady)=0
  text=lese(2,bufferptrbase)
  BigText=UpperCase$(text)

  ' REMOVE STRUCTS

  IF in_Struct=0 THEN
   struct_def=search2(1,Bigtext,definition)

   IF struct_def THEN
    proceed=1
    IF search2(1,Bigtext,declaration) THEN
     proceed=0
    else
     IF struct_def>1 THEN
      IF get_name_of_object_alt(struct_def-1,BigText)<>definition THEN proceed=0
     END IF
    END IF

    IF proceed AND legal(text,struct_def) THEN
     ' If it is really a definition and if it is not within a comment,
     ' then get the name of the struct
     name_of_struct=get_name_of_object(struct_def+6,BigText)

     ' does we need this struct?
     IF FindName&(needed_structs,name_of_struct)=0 THEN
      ' no
      REPEAT
       text=lese(2,bufferptrbase)
      UNTIL search2(1,UpperCase$(text),"END STRUCT") OR PEEK(FileReady)
      text=lese(2,bufferptrbase)
     ELSE
      in_Struct=1
     END IF
    END IF
   END IF
  END IF

  IF in_Struct THEN
   IF UpperCase$(get_name_of_object(1,text))="END" THEN in_Struct=0
  END IF

  schreibe(text)
 WEND

 {* The BREAK OFF is life-rescuing: If the user would press CTRL-C **
 ** after the memory is freed but before this is stored, the ENDE- **
 ** routine would free the memory again -> would cause a 81000009! *}
 BREAK OFF
 FreeMem&(BufferPtr(1,0),BufferPtr(1,1))
 BufferPtr(1,0)=0
END SUB

SUB Usage
 texts (1%)
 Ende
END SUB

{ ----------------------------------------------------------------- }

Start:
 start2&=TIMER
 Texts(4)

 ' The defaults of the options

' Tracing         = 0   ' do not trace
' ShowTime        = 0   ' do not show elapsed time
  Remove_Structs  = 1   ' do remove unused structures
  Remove_Comments = 1   ' do remove EVERY comment
' Remove_Defines  = 0   ' do not ignore defines
' Const_Defines   = 0   ' do not replace defines by CONST
  Replace_Defines = 1   ' but do replace defines directly
  Print_Errors    = 1   ' do print errors/warnings
' RemoveLines     = 0   ' do not remove empty lines

 DECLARE STRUCT _List *liste
 DECLARE STRUCT DefineNode *emptydefine

 FOR i=0 TO 3
  liste=ALLOC(SIZEOF(_list),7)
  StrucBase(i)=liste
  liste->lh_Head=liste+4
  liste->lh_TailPred=liste
 NEXT

 include        = StrucBase(0)
 needed_structs = StrucBase(1)
 defines        = StrucBase(2)
 structures     = StrucBase(3)

 FOR i=1 TO ARGCOUNT
  argument=ARG$(i)
  IF PEEK(@argument)=45 THEN         ' 45 = "-"
   escape=0
   FOR j=2 TO LEN(argument)
    opt=UpperCase$(MID$(argument,j,1))
    CASE
     opt="B":MaxBuffer=val(MID$(argument,j+1)):~
             ++escape:~
             IF MaxBuffer>640 THEN CALL PrErr (106,"")
     opt="L":RemoveLines=1
     opt="Z":ShowTime=1
     opt="T":Tracing=1
     opt="S":Remove_structs=0
     opt="C":Remove_Comments=0
     opt="I":SWAP Remove_Defines,Replace_Defines
     opt="Q":Const_Defines=1
     opt="E":Print_Errors=0
     opt="D":token=get_name_of_object_alt(j+1,argument):~
             value=MID$(argument,search2(3,argument,token)+LEN(token)+1):~
             IF peek(@value)=0 THEN value="1":~
             emptydefine=ALLOC(sizeof(definenode),7):~
             emptydefine->ln_name=copy(token):~
             emptydefine->replace=copy(value):~
             emptydefine->countparam=0:~
             AddTail&(defines,emptydefine):~
             ++escape
     opt="P":object=MID$(argument,j+1):~
             FOR x=2 TO 9:~
              IF peek(@Path(x))=0 THEN Path(x)=object:EXIT FOR:~
             NEXT:~
             ++escape
     opt="U":token=MID$(argument,j+1):~
             escape=FindName&(defines,@token):~
             IF escape THEN call Remove(escape) else ++escape
     100=100:CALL usage
    END CASE
    IF escape THEN escape=0:exit for
   NEXT
  ELSE
   IF peek(@InFile)=0 THEN
    InFile=argument
   ELSE
    IF peek(@OutFile) THEN CALL Usage
    OutFile=argument
   END IF
  END IF
 NEXT
 IF peek(@OutFile)=0 THEN CALL Usage
 IF MaxBuffer=0 or MaxBuffer>640 THEN MaxBuffer=100
 MaxBuffer=MaxBuffer*1024

 OPEN "O",1,OutFile
 CLOSE #1
 IF Err THEN CALL PrErr (107,""):ende

 OPEN "I",2,InFile
 CLOSE #2
 IF ERR THEN CALL PrErr (109,""):ende

 IF Remove_Defines THEN Const_Defines=0
 IF Const_Defines THEN Replace_Defines=0
 IF Remove_Structs=0 THEN TempFile=OutFile
 IF Tracing THEN call texts(2%)

 OPEN "O",1,TempFile
 AddToTemp(2,InFile)

 liste=structures
 IF Remove_Structs THEN
  CLOSE #1
  OPEN "I",2,TempFile
  OPEN "O",1,OutFile
  IF liste->lh_head <> liste+4 THEN
   IF Tracing THEN ?
   RemoveStuff
  ELSE
   {* Why should we try to remove structures, if there are none ?? *}

   LONGINT gelesen,written
   ADDRESS buffer
   maxbuffer=seek&(handle(2),0,1)
   maxbuffer=seek&(handle(2),0,-1)

   buffer=ALLOC(maxbuffer,7)
   while buffer=0
    maxbuffer=shr(maxbuffer,1)
    if maxbuffer<100 then
     PrErr(108,"")
     Texts(3%)
     OutFile=TempFile
     buffer=-1
    else
     buffer=alloc(maxbuffer,7)
    end if
   wend
   if buffer>0 then
    repeat
     gelesen=xRead&(handle(2),buffer,maxbuffer)
     if gelesen then written=xWrite&(handle(1),buffer,gelesen)
    until gelesen<maxbuffer or written<gelesen
   END IF
  END IF
 END IF

 IF ShowTime THEN ? "Elapsed time :"TIMER-start2&
ende