home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Exec 5 / CD_Magazyn_EXEC_nr_5.iso / Programy / Programowanie / AmigaE / powerd.lha / PowerD / source / h2m.d < prev    next >
Encoding:
Text File  |  2000-11-21  |  22.8 KB  |  968 lines
  1. // this source can be compiler with at least version 0.15 of PowerD (10.5.2000 or newer)
  2.  
  3. // history:
  4. // 1.0 initial release
  5. //
  6. // 1.1 1.7.2000
  7. //   - added enumerations
  8. //
  9. // 1.2 18.11.2000
  10. //   - '*' doesn't have to be right before the name in structure definition
  11.  
  12. // todo:
  13. // typedef
  14. // function in structures
  15. // NEWUNION string
  16. // unions instead of structs
  17. // macro to constant optimizer
  18.  
  19. OPT    OPTIMIZE
  20.  
  21. MODULE    'exec/memory'
  22.  
  23. RAISE    "^C"  IF CtrlC()=TRUE,
  24.         "MEM" IF AllocPooled()=NIL,
  25.         "MEM" IF AllocVecPooled()=NIL
  26.  
  27. ENUM    SOURCE,NOCOMMENT,OPTIMIZE
  28. SET    F_NOCOMMENT,F_OPTIMIZE
  29.  
  30. DEF    pool,flags=0
  31.  
  32. BYTE '\n\n$VER: h2m v1.2 by MarK (30.11.2000)\n\n\n\0'
  33.  
  34. PROC main()
  35.     DEF    args:PTR TO LONG,ra,
  36.             name[256]:STRING,dest[256]:STRING,
  37.             src:PTR TO CHAR,l,f=NIL,data
  38.     args:=[NIL,FALSE,FALSE]:LONG
  39.     IF (ra:=ReadArgs('SOURCE/A,NC=NOCOMMENT/S,O=OPTIMIZE/S',args,NIL))=NIL THEN Raise("DOS")
  40.     StringF(name,'\s.h',args[SOURCE])
  41.     StringF(dest,'\s.m',args[SOURCE])
  42.     IF args[NOCOMMENT] THEN flags:=F_NOCOMMENT
  43.     IF args[OPTIMIZE] THEN flags|=F_OPTIMIZE
  44.     IF (l:=FileLength(name))<=0 THEN Raise("DOS")
  45.     IFN pool:=CreatePool(MEMF_PUBLIC|MEMF_CLEAR,16384,4096) THEN Raise("MEM")
  46.     src:=AllocVecPooled(pool,l+16)
  47.     IF f:=Open(name,OLDFILE)
  48.         Read(f,src,l)
  49.         Close(f)
  50.         f:=NIL
  51.         data:=ReadC(src,l)
  52.     ELSE
  53.         Raise("DOS")
  54.     ENDIF
  55.     IF flags AND F_OPTIMIZE
  56.         Optimize(data)
  57.     ENDIF
  58.     IF f:=Open(dest,NEWFILE)
  59.         WriteD(f,data)
  60.         VFPrintF(f,'\n',NIL)
  61.         Close(f)
  62.         f:=NIL
  63.     ELSE
  64.         Raise("DOS")
  65.     ENDIF
  66. EXCEPTDO
  67.     SELECT exception
  68.     CASE "DOS";    PrintFault(IOErr(),'h2m')
  69.     CASE "MEM";    PrintF('\s: not enough memory\n','h2m')
  70.     CASE "EOF";    PrintF('\s: unexpected eof (\d)\n','h2m',exceptioninfo)
  71.     CASE "^C";    PrintF('\s: ***break \s\n','h2m',exceptioninfo)
  72.     CASE "TYP";    PrintF('\s: unknown type (\d)\n','h2m',exceptioninfo)
  73.     CASE "PTR";    PrintF('\s: too deep pointer (\d)\n','h2m',exceptioninfo)
  74.     CASE "STX";    PrintF('\s: syntax error (\d)\n','h2m',exceptioninfo)
  75.     ENDSELECT
  76.     IF f THEN Close(f)
  77.     IF pool THEN DeletePool(pool)
  78.     IF ra THEN FreeArgs(ra)
  79. ENDPROC
  80.  
  81. OBJECT data
  82.     what:WORD,            // DA...
  83.     next:PTR TO macro
  84.  
  85. ENUM    DA_None,
  86.         DA_Comment,
  87.         DA_OBJECT,
  88.         DA_UNION,
  89.         DA_ITEM,
  90.         DA_ENUM,
  91.         DA_Macro,
  92.         DA_OConst        // constant generated by optimizer
  93.  
  94. OBJECT comment OF data
  95.     comment:PTR TO CHAR
  96.  
  97. OBJECT obj OF data
  98.     name:PTR TO CHAR,
  99.     comment:PTR TO comment,
  100.     item:PTR TO item
  101.  
  102. OBJECT item OF data
  103.     name:PTR TO CHAR,
  104.     comment:PTR TO comment,
  105.     type:UBYTE,                // DT...
  106.     flags:UBYTE,            // IF...
  107.     size:LONG,
  108.     obj:PTR TO CHAR        // obj/NIL
  109.  
  110. OBJECT enum OF data
  111.     first:PTR TO const
  112.  
  113. OBJECT const
  114.     next:PTR TO const,
  115.     name:PTR TO CHAR,
  116.     value:LONG,
  117.     comment:PTR TO comment
  118.  
  119. SET    IF_UNION                        // item is an UNION
  120.  
  121. ENUM    DT_VOID,                        // cut from dc.e
  122.         DT_LONG,
  123.         DT_ULONG,
  124.         DT_WORD,
  125.         DT_UWORD,
  126.         DT_BYTE,
  127.         DT_UBYTE,
  128.         DT_FLOAT,
  129.         DT_DOUBLE,
  130.         DT_BOOL,
  131.         DT_CUSTOM,                    -> object - global field
  132.         DT_PTR,                        -> VOID pointer
  133.         DT_DLONG,
  134.         DT_UDLONG,
  135.         DT_STRING,
  136.         DT_BASE
  137.  
  138. OBJECT macro OF data
  139.     type:WORD,
  140.     name:PTR TO CHAR,
  141.     args:PTR TO CHAR,
  142.     comment:PTR TO CHAR,
  143.     mline:PTR TO mline
  144.  
  145. ENUM    MT_define,
  146.         MT_include,
  147.         MT_ifdef,
  148.         MT_ifndef,
  149.         MT_endif
  150.  
  151. OBJECT mline
  152.     next:PTR TO mline,
  153.     data:PTR TO CHAR,
  154.     comment:PTR TO CHAR
  155.  
  156. OBJECT oconst OF data
  157.     name:PTR TO CHAR,
  158.     value:LONG,
  159.     comment:PTR TO comment
  160.  
  161. PROC ReadC(src:PTR TO CHAR,l)(L)
  162.     DEF    last=NIL:PTR TO data,frst=NIL:PTR TO data,pos=0,
  163.             data:PTR TO data,name[80]:CHAR
  164.     WHILE pos<l
  165.         data:=NIL
  166.         pos:=Crop(src,pos,l)
  167.         IF (src[pos]="/"&&src[pos+1]="/")||(src[pos]="/"&&src[pos+1]="*")
  168.             pos,data:=Comment(src,pos,l)
  169.         ELSEIF src[pos]="#"
  170.             pos,data:=Macro(src,pos,l)
  171.         ELSE
  172.             pos:=GetName(name,src,pos,l)
  173.             IF StrCmp(name,'struct')
  174.                 pos,data:=OBJECT(src,pos,l)
  175.             ELSEIF StrCmp(name,'enum')
  176.                 pos,data:=ENUM(src,pos,l)
  177.             ELSE
  178.                 pos++
  179.             ENDIF
  180.             name[0]:="\0"
  181.         ENDIF
  182.         IFN frst THEN frst:=data
  183.         IF  last THEN last.next:=data
  184.         IF  data THEN last:=data
  185.         WHILE last.next DO last:=.next
  186.         CtrlC()
  187.         IF CtrlD() THEN RETURN frst
  188.     EXITIF src[pos]="\0"
  189.     ENDWHILE
  190. ENDPROC frst
  191.  
  192. // read one or more comments if available
  193. PROC Comment(src:PTR TO CHAR,pos,l)(LONG,PTR TO comment)
  194.     DEF    opos=pos,comment=NIL:PTR TO comment,data:PTR TO CHAR,first=NIL:PTR TO comment,
  195.             last=NIL:PTR TO comment
  196.     WHILE src[pos]="/"&&src[pos+1]="/"
  197.         WHILE src[pos]<>"\n"
  198.             pos++
  199.             CtrlC()
  200.         ENDWHILE
  201.     ELSEWHILE src[pos]="/"&&src[pos+1]="*"
  202.         REPEAT
  203.             pos++
  204.             CtrlC()
  205.         UNTIL src[pos]="*"&&src[pos+1]="/"
  206.         pos+=2
  207.     ALWAYS
  208.         IFN flags&F_NOCOMMENT
  209.             comment:=AllocPooled(pool,SIZEOF_comment)
  210.             comment.what:=DA_Comment
  211.             data:=AllocVecPooled(pool,pos-opos+4)
  212.             StrCopy(data,src+opos,pos-opos)
  213.             comment.comment:=data
  214. //            PrintF('(\d) \s\n',opos,data)
  215.             IFN first THEN first:=comment
  216.             IF last THEN last.next:=comment
  217.             last:=comment
  218.         ENDIF
  219. //        pos:=Crop(src,pos,l)
  220.         opos:=pos
  221.     ENDWHILE
  222. ENDPROC pos,first
  223.  
  224. PROC OBJECT(src:PTR TO CHAR,pos,l,union=FALSE)(LONG,PTR TO obj)
  225.     DEF    name[80]:CHAR,obj:PTR TO obj,next=TRUE,item:PTR TO item,type,objn:PTR TO CHAR,
  226.             last=NIL:PTR TO item,ptr,opos
  227.     obj:=AllocPooled(pool,SIZEOF_obj)
  228.     IFN union
  229.         obj.what:=DA_OBJECT
  230.         pos:=Skip(src,pos,l)
  231.         pos:=GetName(name,src,pos,l)
  232.         obj.name:=AllocPooled(pool,StrLen(name)+4)
  233.         StrCopy(obj.name,name)
  234.         pos:=Crop(src,pos,l)
  235.         pos,obj.comment:=Comment(src,pos,l)
  236.     ENDIF
  237. //    PrintF('(\d) \s\n',pos,obj.name)
  238.     pos:=Skip(src,pos,l)
  239.     IF src[pos]="{" THEN pos++ //ELSE Raise("STX",pos)
  240.     WHILE next
  241.         opos:=pos:=Skip(src,pos,l)
  242.         pos:=GetName(name,src,pos,l)    // read type
  243. //        PrintF('(\d) \s\n',pos,name)
  244.         objn:=NIL
  245.         next:=TRUE
  246.  
  247.         SELECT TRUE
  248.         CASE StrCmp(name,'int'),StrCmp(name,'long'),StrCmp(name,'LONG')
  249.                                                 type:=DT_LONG
  250.         CASE StrCmp(name,'ULONG');        type:=DT_ULONG
  251.         CASE StrCmp(name,'WORD');        type:=DT_WORD
  252.         CASE StrCmp(name,'UWORD');        type:=DT_UWORD
  253.         CASE StrCmp(name,'BYTE');        type:=DT_BYTE
  254.         CASE StrCmp(name,'UBYTE'),StrCmp(name,'char')
  255.                                                 type:=DT_UBYTE
  256.         CASE StrCmp(name,'STRPTR');    type:=DT_UBYTE+%100000
  257.         CASE StrCmp(name,'float');        type:=DT_FLOAT
  258.         CASE StrCmp(name,'double');    type:=DT_DOUBLE
  259.         CASE StrCmp(name,'APTR'),StrCmp(name,'BPTR'),StrCmp(name,'CPTR')
  260.                                                 type:=DT_PTR
  261.         CASE StrCmp(name,'struct');    type:=DT_CUSTOM
  262.             pos:=Skip(src,pos,l)
  263.             IF src[pos]="{"
  264.                 pos,item:=OBJECT(src,pos,l,TRUE)
  265. //                PrintF('(\d) \s\n',pos,item.name)
  266.                 IFN obj.item THEN obj.item:=item
  267.                 IF last THEN last.next:=item
  268.                 last:=item
  269.                 next:=FALSE
  270.             ELSE
  271.                 pos:=GetName(name,src,pos,l)
  272.                 objn:=AllocPooled(pool,StrLen(name)+4)
  273.                 StrCopy(objn,name)
  274.                 pos:=Skip(src,pos,l)
  275.             ENDIF
  276.         CASE StrCmp(name,'union');        type:=DT_CUSTOM
  277.             pos:=Skip(src,pos,l)
  278.             IF src[pos]="{"
  279.                 pos,item:=OBJECT(src,pos,l,TRUE)
  280. //                PrintF('(\d) \s\n',pos,item.name)
  281.                 IFN obj.item THEN obj.item:=item
  282.                 IF last THEN last.next:=item
  283.                 last:=item
  284.                 next:=FALSE
  285.             ENDIF
  286.         DEFAULT;                                type:=DT_CUSTOM
  287.             objn:=AllocPooled(pool,StrLen(name)+4)
  288.             StrCopy(objn,name)
  289.             pos:=Skip(src,pos,l)
  290. //            Raise("TYP",opos)
  291.         ENDSELECT
  292.  
  293. //        PrintF('type=\d\n',type)
  294.  
  295.         // next is TRUE
  296.         WHILE next
  297.             pos:=Skip(src,pos,l)
  298.             item:=AllocPooled(pool,SIZEOF_item)
  299.             item.what:=DA_ITEM
  300.             item.obj:=objn
  301.             item.type:=type
  302.             ptr:=0
  303.             WHILE src[pos]="*" DO pos++;    ptr++
  304.             pos:=Skip(src,pos,l)
  305.             IF ptr>4 THEN Raise("PTR",pos)
  306.             item.type|=ptr<<5
  307.             pos:=GetName(name,src,pos,l)
  308.             item.name:=AllocPooled(pool,StrLen(name)+4)
  309.             StrCopy(item.name,name)
  310. //            PrintF('(\d) \s(\d)\n',pos,name,ptr)
  311.             pos:=Crop(src,pos,l)
  312. //            PrintF('(\d) \s\n',pos,name)
  313.             IF src[pos]="["
  314. //                PrintF('Yes\n')
  315.                 opos:=++pos
  316.                 pos:=Find("]",src,pos,l)
  317.                 StrCopy(name,src+opos,pos-opos)
  318.                 C2D(name)
  319.                 item.size:=AllocPooled(pool,StrLen(name)+4)
  320.                 StrCopy(item.size,name)
  321.                 pos++
  322.             ENDIF
  323.             pos:=Crop(src,pos,l)
  324.             IF src[pos]=","
  325.                 next:=TRUE
  326.                 pos++
  327.             ELSE
  328.                 next:=FALSE
  329.             ENDIF
  330.             pos:=Crop(src,pos,l)
  331.             pos,item.comment:=Comment(src,pos,l)
  332.             pos:=Skip(src,pos,l)
  333.             IFN obj.item THEN obj.item:=item
  334.             IF last THEN last.next:=item
  335.             last:=item
  336.             CtrlC()
  337.         ENDWHILE
  338.     EXITIF src[pos]="}" DO pos:=Crop(src,++pos,l)
  339.         next:=TRUE
  340.     ENDWHILE
  341.     IF union
  342.         obj.what:=DA_UNION
  343.         pos:=Skip(src,pos,l)
  344.         pos:=GetName(name,src,pos,l)
  345. //        PrintF('(\d) \s\n',pos,name)
  346.         obj.name:=AllocPooled(pool,StrLen(name)+4)
  347.         StrCopy(obj.name,name)
  348.         pos:=Crop(src,pos,l)
  349.         pos,obj.comment:=Comment(src,pos,l)
  350.     ENDIF
  351. ENDPROC pos,obj
  352.  
  353. PROC ENUM(src:PTR TO CHAR,pos,l)(LONG,PTR TO ENUM)
  354.     DEF    enum:PTR TO enum,next=TRUE,const:PTR TO const,prev=NIL:PTR TO const
  355.     DEF    name[64]:STRING,value=0
  356.     enum:=AllocPooled(pool,SIZEOF_enum)
  357.     enum.what:=DA_ENUM
  358.     pos:=Skip(src,pos,l)
  359.     pos:=GetName(name,src,pos,l)
  360.     pos:=Skip(src,pos,l)
  361. //    PrintF('\d=\s\n',pos,name)
  362.     IF src[pos]<>"{" THEN Raise("STX",pos) ELSE pos++
  363.     WHILE next
  364.         pos:=Skip(src,pos,l)
  365.         const:=AllocPooled(pool,SIZEOF_const)
  366.         IFN enum.first THEN enum.first:=const
  367.         IF prev THEN prev.next:=const
  368.  
  369.         pos:=GetName(name,src,pos,l)
  370.         const.name:=AllocPooled(pool,StrLen(name)+4)
  371.         StrCopy(const.name,name)
  372.  
  373.         pos:=Skip(src,pos,l)
  374. //        PrintF('1=\d\n',pos)
  375.         IF src[pos]="="
  376.             pos,value:=GetNum(src,pos+1,l)
  377.         ENDIF
  378. //        PrintF('2=\d\n',pos)
  379.  
  380.         const.value:=value
  381.  
  382.         pos:=Crop(src,pos,l)
  383.         pos,const.comment:=Comment(src,pos,l)
  384.         pos:=Skip(src,pos,l)
  385. //        PrintF('3=\d\n',pos)
  386.  
  387. //        PrintF('\s=\d\n',const.name,const.value)
  388.  
  389.         IF src[pos]=","
  390.             pos++
  391.         ELSEIF src[pos]="}"
  392.             next:=FALSE
  393.             pos++
  394.         ELSE
  395.             Raise("STX",pos)
  396.         ENDIF
  397.  
  398.         value++
  399.         prev:=const
  400.     ENDWHILE
  401. ENDPROC pos,enum
  402.  
  403. PROC Macro(src:PTR TO CHAR,pos,l)(LONG,PTR TO macro)
  404.     DEF    opos,macro=NIL:PTR TO macro,name[80]:STRING,next,ml,
  405.             line:PTR TO mline,last:PTR TO mline,buf[1024]:STRING,cpos
  406.     macro:=AllocPooled(pool,SIZEOF_macro)
  407.     macro.what:=DA_Macro
  408.     pos:=Skip(src,pos,l)
  409.     pos:=GetName(name,src,pos,l)
  410.     IF StrCmp(name,'#define')
  411.         macro.type:=MT_define
  412.         pos:=Skip(src,pos,l)
  413.         pos:=GetName(name,src,pos,l)
  414.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  415.         StrCopy(macro.name,name)
  416.         IF src[pos]="("
  417.             opos:=pos
  418.             pos:=Find(")",src,pos,l)
  419.             macro.args:=AllocPooled(pool,pos-opos+4)
  420.             StrCopy(macro.args,src+opos,pos-opos)
  421.         ENDIF
  422.         next:=TRUE
  423.         last:=NIL
  424.         WHILE next
  425.             opos:=pos
  426.             pos:=MaCrop(src,pos,l)
  427.             line:=AllocPooled(pool,SIZEOF_mline)
  428.             StrCopy(buf,src+opos,pos-opos)
  429.             cpos:=C2D(buf)
  430.             ml:=StrLen(buf)+1
  431.             IF cpos<100000 THEN ml-=ml-cpos
  432.             line.data:=AllocPooled(pool,ml+4)
  433.             StrCopy(line.data,buf,ml-1)
  434. //            PrintF('\s\n',line.data)
  435.             IF src[pos]="\\"
  436.                 pos++
  437.                 next:=TRUE
  438.                 pos:=Crop(src,pos,l)
  439.                 pos,line.comment:=Comment(src,pos,l)
  440.             ELSE
  441.                 next:=FALSE
  442.                 IF cpos<100000 THEN pos,line.comment:=Comment(src,opos+cpos,l)
  443.                 pos++                // skip "\n"
  444.             ENDIF
  445.             IFN macro.mline THEN macro.mline:=line
  446.             IF last THEN last.next:=line
  447.             last:=line
  448.             CtrlC()
  449.         ENDWHILE
  450.     ELSEIF StrCmp(name,'#ifdef')
  451.         macro.type:=MT_ifdef
  452.         pos:=Skip(src,pos,l)
  453.         pos:=GetName(name,src,pos,l)
  454.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  455.         StrCopy(macro.name,name)
  456.     ELSEIF StrCmp(name,'#ifndef')
  457.         macro.type:=MT_ifndef
  458.         pos:=Skip(src,pos,l)
  459.         pos:=GetName(name,src,pos,l)
  460.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  461.         StrCopy(macro.name,name)
  462.     ELSEIF StrCmp(name,'#endif')
  463.         macro.type:=MT_endif
  464.     ELSEIF StrCmp(name,'#include')
  465.         macro.type:=MT_include
  466.         pos:=Skip(src,pos,l)
  467.         IF src[pos]="\q"
  468.             opos:=++pos
  469.             WHILE src[pos]<>"\q" DO pos++
  470.             buf[0]:="*"
  471.             StrCopy(buf+1,src+opos,pos-opos)
  472.         ELSEIF src[pos]="<"
  473.             opos:=++pos
  474.             WHILE src[pos]<>">" DO pos++
  475.             StrCopy(buf,src+opos,pos-opos)
  476.         ENDIF
  477.         ml:=StrLen(buf)
  478.         IF buf[ml-2]="."&&buf[ml-1]="h" THEN buf[ml-2]:="\0"
  479.         macro.name:=AllocPooled(pool,ml+4)
  480.         StrCopy(macro.name,buf)
  481.         pos++                // skip "\q" or ">"
  482.     ENDIF
  483. ENDPROC pos,macro
  484.  
  485. // this function replaces: '->' to '.', '0x' to '$'
  486. PROC C2D(src:PTR TO CHAR)(LONG)
  487.     DEF    spos=0,dpos=0,l=StrLen(src),cpos=100000
  488.     WHILE spos<l        // dpos is always smaller or equal then spos
  489.         IF src[spos]="-"&&src[spos+1]=">"
  490.             src[dpos]:="."
  491.             spos++
  492.         ELSEIF src[spos]="0"&&src[spos+1]="x"
  493.             src[dpos]:="$"
  494.             spos++
  495. //        ELSEIF IsHex(src[spos])&&src[spos+1]="L"
  496.         ELSEIF src[spos]>="0"&&src[spos]<="9"&&src[spos+1]="L"
  497.             src[dpos]:=src[spos]
  498.             spos++
  499.         ELSEIF src[spos]>="0"&&src[spos]<="9"&&src[spos+1]="U"&&src[spos+2]="L"
  500.             src[dpos]:=src[spos]
  501.             spos+++
  502.         ELSEIF src[spos]="\q"
  503.             src[dpos]:="\a"
  504.         ELSEIF src[spos]="\a"
  505.             src[dpos]:="\q"
  506.         ELSEIF src[spos]="%"
  507.             src[dpos]:="\\"
  508.         ELSEIF src[spos]="/"&&src[spos+1]="/"
  509.             IF cpos=100000 THEN cpos:=spos
  510.         ELSEIF src[spos]="/"&&src[spos+1]="*"
  511.             IF cpos=100000 THEN cpos:=spos
  512.         ELSE
  513.             src[dpos]:=src[spos]
  514.         ENDIF
  515.         spos++
  516.         dpos++
  517.         CtrlC()
  518.     ENDWHILE
  519.     src[dpos]:="\0"
  520. ENDPROC cpos            // position of comment
  521.  
  522. PROC WriteD(f,data:PTR TO macro)
  523.     DEF    prev
  524.     WHILE data
  525.         prev:=data
  526.         // this loop removes #ifndef and #endif lines from destination
  527.         WHILE data.what=DA_Macro&&data.type=MT_ifndef
  528.             DEF    next=data.next:PTR TO macro
  529.             IF next
  530.                 IF next.what=DA_Macro&&next.type=MT_include
  531.                     IF next.next.what=DA_Macro&&next.next.type=MT_endif
  532.                         WriteMacro(f,next)
  533.                         IF next.next THEN IFN data:=next.next.next THEN RETURN
  534.                     ENDIF
  535.                 ENDIF
  536.             ENDIF
  537.         EXITIF prev=data
  538.         ENDWHILE
  539.         SELECT data.what
  540.         CASE DA_Comment;    WriteComment(f,data)
  541.         CASE DA_OBJECT;    WriteOBJECT(f,data)
  542.         CASE DA_ENUM;        WriteENUM(f,data)
  543.         CASE DA_Macro;        WriteMacro(f,data)
  544.         CASE DA_OConst;    data:=WriteCONST(f,data)
  545.         ENDSELECT
  546.         data:=.next
  547.         CtrlC()
  548.     ENDWHILE
  549. ENDPROC
  550.  
  551. PROC WriteComment(f,comment:PTR TO comment)
  552.     FPrintF(f,'\s\n',comment.comment)
  553. ENDPROC
  554.  
  555. PROC WriteOBJECT(f,obj:PTR TO obj,level=0)
  556.     DEF    item:PTR TO item,maxl=0,l
  557.     item:=obj.item
  558.     // find maximal name length
  559. //    WHILE item DO maxl:=Max(maxl,ItemLen(item));    item:=.next
  560.     WHILE item DO IF (l:=ItemLen(item))>maxl THEN maxl:=l;    item:=.next
  561.  
  562.     IF obj.what=DA_UNION&&level>0 THEN FOR l:=1 TO level FPrintF(f,'\t', NIL)
  563.     FPrintF(f,'\s \s',IF obj.what=DA_OBJECT THEN 'OBJECT' ELSE 'NEWUNION',obj.name)
  564.     IF obj.comment
  565.         l:=StrLen(item)+3
  566.         WHILE l<maxl DO l++;    FPrintF(f,' ',NIL)
  567.         WriteD(f,obj.comment)
  568.     ELSE
  569.         FPrintF(f,'\n',NIL)
  570.     ENDIF
  571.  
  572.     item:=obj.item
  573.     WHILE item
  574.         IF item.what=DA_UNION
  575.             WriteOBJECT(f,item,level+1)
  576.         ELSE
  577.             FOR l:=0 TO level FPrintF(f,'\t', NIL)
  578.             FPrintF(f,'\s',item.name)
  579.             IF item.size THEN FPrintF(f,'[\s]',item.size)
  580.             FPrintF(f,':\s',TypeStr(item.type))
  581.             IF item.obj THEN FPrintF(f,item.obj,NIL)
  582.         ENDIF
  583.         IF item.next THEN FPrintF(f,',',NIL)
  584.         IF item.comment
  585.             l:=ItemLen(item)
  586.             l-=4
  587.             IFN item.next THEN l--
  588.             WHILE l<maxl DO l++;    FPrintF(f,' ',NIL)
  589.             WriteD(f,item.comment)
  590.         ELSE
  591.             FPrintF(f,'\n',NIL)
  592.         ENDIF
  593.         item:=.next
  594.         CtrlC()
  595.     ENDWHILE
  596.     IF obj.what=DA_UNION&&level>0 THEN FOR l:=1 TO level FPrintF(f,'\t', NIL)
  597.     FPrintF(f,IF obj.what=DA_OBJECT THEN '\n' ELSE 'ENDUNION',obj.name)
  598. ENDPROC
  599.  
  600. PROC WriteENUM(f,enum:PTR TO enum)
  601.     DEF    const:PTR TO const,value=0
  602.     const:=enum.first
  603.     FPrintF(f,'ENUM\t',NIL)
  604.     WHILE const
  605.         IF const<>enum.first THEN FPrintF(f,'\t\t',NIL)
  606.         FPrintF(f,'\s',const.name)
  607.         IF const.value<>value
  608.             FPrintF(f,'=\d',const.value)
  609.             value:=const.value
  610.         ENDIF
  611.         value++
  612.         const:=const.next
  613.         IF const THEN FPrintF(f,',',NIL)
  614.         FPrintF(f,'\n',NIL)
  615.     ENDWHILE
  616.     FPrintF(f,'\n',NIL)
  617. ENDPROC
  618.  
  619. PROC WriteMacro(f,macro:PTR TO macro)
  620.     SELECT macro.type
  621.     CASE MT_define
  622.         DEF    line:PTR TO mline
  623.         FPrintF(f,'#define \s\s',macro.name,macro.args)
  624.         line:=macro.mline
  625.         WHILE line
  626.             FPrintF(f,' \s',line.data)
  627.             IF line.next THEN FPrintF(f,'\\',NIL)
  628.             IF line.comment
  629.                 FPrintF(f,'\t',NIL)
  630.                 WriteD(f,line.comment)
  631.             ELSE FPrintF(f,'\n',NIL)
  632.             line:=.next
  633.             CtrlC()
  634.         ENDWHILE
  635.     CASE MT_include
  636.         IFN StrCmp(macro.name,'exec/types') THEN FPrintF(f,'MODULE\t''\s''\n',macro.name)
  637.     CASE MT_ifdef
  638.         FPrintF(f,'#ifdef \s\n',macro.name)
  639.     CASE MT_ifndef
  640.         FPrintF(f,'#ifndef \s\n',macro.name)
  641.     CASE MT_endif
  642.         FPrintF(f,'#endif\n',NIL)
  643.     ENDSELECT
  644. ENDPROC
  645.  
  646. PROC WriteCONST(f,const:PTR TO oconst)(PTR TO oconst)
  647.     FPrintF(f,'CONST\t\s=\d',const.name,const.value)
  648.     IF const.next
  649.         IF const.next.what=DA_OConst
  650.             IF const:=.next
  651.                 WHILE const.what=DA_OConst
  652.                     FPrintF(f,',\n\t\t\s=\d',const.name,const.value)
  653.                 EXITIF const.next=NIL
  654.                     const:=.next
  655.                 ENDWHILE
  656.             ENDIF
  657.             FPrintF(f,'\n',NIL)
  658.         ENDIF
  659.     ELSE FPrintF(f,'\n',NIL)
  660. ENDPROC const
  661.  
  662. PROC ItemLen(item:PTR TO item)(L)
  663.     DEF    l,ptr
  664.     l:=StrLen(item.name)
  665.     IF item.size THEN l+=StrLen(item.size)+2
  666.     IF item.obj THEN l+=StrLen(item.obj)
  667.     SELECT item.type&$1f                                        // add ':type'
  668.     CASE DT_PTR;                                                l+=4
  669.     CASE DT_LONG,DT_WORD,DT_BYTE,DT_BOOL,DT_VOID;    l+=5
  670.     CASE DT_ULONG,DT_UWORD,DT_UBYTE,DT_FLOAT;            l+=6
  671.     CASE DT_DOUBLE;                                            l+=7
  672.     DEFAULT;                                                        l++
  673.     ENDSELECT
  674.     ptr:=item.type>>5
  675.     l+=ptr*7                    // length of 'PTR TO '
  676. ENDPROC l
  677.  
  678. PROC TypeStr(type)(PTR TO CHAR)
  679.     DEF    str:PTR TO CHAR
  680.     SELECT type
  681.     CASE 1;    str:='LONG'
  682.     CASE 2;    str:='ULONG'
  683.     CASE 3;    str:='WORD'
  684.     CASE 4;    str:='UWORD'
  685.     CASE 5;    str:='BYTE'
  686.     CASE 6;    str:='UBYTE'
  687.     CASE 7;    str:='FLOAT'
  688.     CASE 8;    str:='DOUBLE'
  689.     CASE 9;    str:='BOOL'
  690.     CASE 10;    str:=NIL
  691.     CASE 11;    str:='PTR'
  692.     CASE 12;    str:='DLONG'
  693.     CASE 13;    str:='UDLONG'
  694.     CASE 14;    str:='STRING'
  695.  
  696.     CASE 33;    str:='PTR TO LONG'
  697.     CASE 34;    str:='PTR TO ULONG'
  698.     CASE 35;    str:='PTR TO WORD'
  699.     CASE 36;    str:='PTR TO UWORD'
  700.     CASE 37;    str:='PTR TO BYTE'
  701.     CASE 38;    str:='PTR TO UBYTE'
  702.     CASE 39;    str:='PTR TO FLOAT'
  703.     CASE 40;    str:='PTR TO DOUBLE'
  704.     CASE 41;    str:='PTR TO BOOL'
  705.     CASE 42;    str:='PTR TO '
  706.     CASE 43;    str:='PTR TO PTR'
  707.     CASE 44;    str:='PTR TO DLONG'
  708.     CASE 45;    str:='PTR TO UDLONG'
  709.     CASE 46;    str:='PTR TO CHAR'
  710.  
  711.     CASE 65;    str:='PTR TO PTR TO LONG'
  712.     CASE 66;    str:='PTR TO PTR TO ULONG'
  713.     CASE 67;    str:='PTR TO PTR TO WORD'
  714.     CASE 68;    str:='PTR TO PTR TO UWORD'
  715.     CASE 69;    str:='PTR TO PTR TO BYTE'
  716.     CASE 70;    str:='PTR TO PTR TO UBYTE'
  717.     CASE 71;    str:='PTR TO PTR TO FLOAT'
  718.     CASE 72;    str:='PTR TO PTR TO DOUBLE'
  719.     CASE 73;    str:='PTR TO PTR TO BOOL'
  720.     CASE 74;    str:='PTR TO PTR TO '
  721.     CASE 75;    str:='PTR TO PTR TO PTR'
  722.     CASE 76;    str:='PTR TO PTR TO DLONG'
  723.     CASE 77;    str:='PTR TO PTR TO UDLONG'
  724.     CASE 78;    str:='PTR TO PTR TO CHAR'
  725.  
  726.     CASE 129;str:='LIST OF LONG'
  727.     CASE 130;str:='LIST OF ULONG'
  728.     CASE 131;str:='LIST OF WORD'
  729.     CASE 132;str:='LIST OF UWORD'
  730.     CASE 133;str:='LIST OF BYTE'
  731.     CASE 134;str:='LIST OF UBYTE'
  732.     CASE 135;str:='LIST OF FLOAT'
  733.     CASE 136;str:='LIST OF DOUBLE'
  734.     CASE 137;str:='LIST OF BOOL'
  735.     CASE 138;str:='LIST OF '
  736.     CASE 139;str:='LIST OF PTR'
  737.     CASE 140;str:='LIST OF DLONG'
  738.     CASE 141;str:='LIST OF UDLONG'
  739.     CASE 142;str:='LIST OF CHAR'
  740.     DEFAULT;    str:='VOID'
  741.     ENDSELECT
  742. ENDPROC str
  743.  
  744. PROC GetNum(s:PTR TO CHAR,n=0,l)(LONG,LONG)
  745.     DEF    num=0,sign=1
  746.     WHILE s[n]="\t" OR s[n]="\n" OR s[n]=" " DO n++
  747.     IF s[n]="-"
  748.         sign:=-1
  749.         n++
  750.     ENDIF
  751.     IF s[n]="0" AND s[n+1]="x"                                    // HEXADECIMAL number
  752.         n+++
  753.         WHILE s[n]>="0" AND s[n]<="9"
  754.             num<<=4
  755.             num|=s[n]-"0"
  756.         ELSEWHILE s[n]>="a" AND s[n]<="f"
  757.             num<<=4
  758.             num|=s[n]-"a"+10
  759.         ELSEWHILE s[n]>="A" AND s[n]<="F"
  760.             num<<=4
  761.             num|=s[n]-"A"+10
  762.         ALWAYS
  763.             n++
  764.             IF n>l THEN Raise("EOF",n)
  765.         ENDWHILE
  766.     ELSE                                                                // DECIMAL number
  767.         WHILE s[n]>="0" AND s[n]<="9"
  768.             num*=10
  769.             num+=s[n]-"0"
  770.             n++
  771.             IF n>l THEN Raise("EOF",n)
  772.         ENDWHILE
  773.     ENDIF
  774. ENDPROC n,num*sign
  775.  
  776. PROC GetName(name:PTR TO CHAR,src:PTR TO CHAR,pos,length)(L,PTR)
  777.     DEF i=0
  778.     IF name
  779.         IF IsAlpha(src[pos])
  780.             WHILE IsAlphaNum(src[pos])
  781.                 name[i]:=src[pos]
  782.                 pos++
  783.                 i++
  784.                 CtrlC()
  785.                 IF pos>length THEN Raise("EOF",pos)
  786.             ENDWHILE
  787.             name[i]:="\0"
  788.         ENDIF
  789.     ELSE
  790.         IF IsAlpha(src[pos])
  791.             WHILE IsAlphaNum(src[pos])
  792.                 pos++
  793.                 CtrlC()
  794.                 IF pos>length THEN Raise("EOF",pos)
  795.             ENDWHILE
  796.             name:=TRUE
  797.         ENDIF
  798.     ENDIF
  799. ENDPROC pos,name
  800.  
  801. PROC GetString(str:PTR TO CHAR,src:PTR TO CHAR,pos,length)(L,PTR)
  802.     DEF i=0
  803.     IF (src[pos]=34)||(src[pos]="<")
  804.         pos++
  805.         WHILE (src[pos]<>34)&&(src[pos]<>">")
  806.             str[i]:=src[pos]
  807.             pos++
  808.             i++
  809.             CtrlC()
  810.             IF pos>length THEN Raise("EOF",pos)
  811.         ENDWHILE
  812.         str[i]:="\0"
  813.         pos++                // skip ",>
  814.     ENDIF
  815. ENDPROC pos,str
  816.  
  817. PROC Find(char,src:PTR TO CHAR,pos,length)(L)
  818.     WHILE src[pos]<>char
  819.         pos++
  820.         CtrlC()
  821.         IF pos>length THEN Raise("EOF",pos)
  822.     ENDWHILE
  823. ENDPROC pos
  824.  
  825. PROC IsAlpha(char)(L) IS IF ((char>="A")&&(char<="Z"))||((char>="a")&&(char<="z"))||(char="_")||(char="#") THEN TRUE ELSE FALSE
  826. PROC IsAlphaNum(char)(L) IS IF ((char>="A")&&(char<="Z"))||((char>="a")&&(char<="z"))||(char="_")||((char>="0")&&(char<="9"))||(char="#") THEN TRUE ELSE FALSE
  827. PROC IsFirstNum(char)(L) IS IF ((char>="0")&&(char<="9"))||(char=".")||(char="$")||(char="%")||(char="-") THEN TRUE ELSE FALSE
  828.  
  829. // skip whitespaces and comments
  830. PROC Skip(src:PTR TO CHAR,pos,length)(L)
  831.     DEF done=FALSE,char
  832.     REPEAT
  833.         char:=src[pos]
  834.         IF char=" "
  835.             pos++
  836.         ELSEIF char="\t"
  837.             pos++
  838.         ELSEIF char=";"
  839.             pos++
  840.         ELSEIF char="\n"
  841.             pos++
  842.         ELSEIF char="/"
  843.             IF src[pos+1]="*"
  844.                 pos++
  845.                 REPEAT
  846.                     pos++
  847.                     IF pos>length THEN RETURN pos
  848.                 UNTIL (src[pos-1]="*")&&(src[pos]="/")
  849.                 pos++
  850.             ELSEIF src[pos+1]="/"
  851.                 pos++
  852.                 REPEAT
  853.                     pos++
  854.                     IF pos>length THEN RETURN pos
  855.                 UNTIL (src[pos]="\n")||((src[pos-1]="/")&&(src[pos]="/"))
  856.                 pos++
  857.             ELSE
  858.                 done:=TRUE
  859.             ENDIF
  860.         ELSE
  861.             done:=TRUE
  862.         ENDIF
  863.         IF pos>length THEN Raise("EOF",pos)
  864.     UNTIL done=TRUE
  865. ENDPROC pos
  866.  
  867. // skip whitespaces only
  868. PROC Crop(src:PTR TO CHAR,pos,length)(L)
  869.     DEF done=FALSE,char
  870.     REPEAT
  871.         char:=src[pos]
  872.         IF char=" "
  873.             pos++
  874.         ELSEIF char="\t"
  875.             pos++
  876.         ELSEIF char=";"
  877.             pos++
  878.         ELSEIF char="\n"
  879.             pos++
  880.         ELSE
  881.             done:=TRUE
  882.         ENDIF
  883.         IF pos>length THEN Raise("EOF",pos)
  884.     UNTIL done=TRUE
  885. ENDPROC pos
  886.  
  887. PROC MaCrop(src:PTR TO CHAR,pos,length)(L)
  888.     DEF    cpos=-1,qpos=-1,apos=-1
  889.     WHILE src[pos]<>"\n"
  890.         IF src[pos]="/" AND src[pos+1]="/" THEN cpos:=0
  891.         IF src[pos]="/" AND src[pos+1]="*" THEN cpos:=0
  892.         IF src[pos]="*" AND src[pos+1]="/" THEN cpos:=-1
  893.         IF src[pos]="\q" THEN qpos:=~qpos
  894.         IF src[pos]="\a" THEN apos:=~apos
  895.         IF src[pos]="\\" THEN IF cpos=-1 AND qpos=-1 AND apos=-1 THEN RETURN pos
  896.         pos++
  897.         IF pos>length THEN Raise("EOF",pos)
  898.     ENDWHILE
  899. ENDPROC pos
  900.  
  901. PROC Optimize(first:PTR TO data)(PTR)
  902.     DEF    prev=NIL:PTR TO data,data=first:PTR TO data,cnst:PTR TO oconst
  903.     DEF    macro:PTR TO macro,mline:PTR TO mline,bool:BOOL,flt:BOOL,value
  904.  
  905.     // change all number-only macros to constants
  906.     WHILE data
  907.         IF data.what=DA_Macro
  908.             macro:=data
  909.             IF macro.type=MT_define && macro.args=NIL
  910.                 IF mline:=macro.mline
  911.                     IF mline.next=NIL
  912.                         IF bool,flt:=CheckNumber(mline.data)
  913.                             IFN flt
  914.                                 cnst:=AllocPooled(pool,SIZEOF_oconst)
  915.                                 cnst.what:=DA_OConst
  916.                                 cnst.next:=data.next
  917.                                 cnst.name:=macro.name
  918.                                 value:=Val(mline.data)
  919.                                 cnst.value:=value
  920.                                 cnst.comment:=mline.comment
  921.                                 IF prev THEN prev.next:=cnst ELSE first:=cnst
  922.                                 data:=cnst
  923.                             ENDIF
  924.                         ENDIF
  925.                     ENDIF
  926.                 ENDIF
  927.             ENDIF
  928.         ENDIF
  929.         prev:=data
  930.         data:=.next
  931.         CtrlC()
  932.     ENDWHILE
  933. ENDPROC first
  934.  
  935. PROC CheckNumber(str:PTR TO CHAR)(BOOL,BOOL)
  936.     DEF    number=TRUE:BOOL,n=0,float=FALSE:BOOL
  937.     n:=Crop(str,0,StrLen(str))
  938.     IF IsFirstNum(str[n])
  939.         n++
  940.         WHILE str[n]
  941.             IF IsHex(str[n])
  942.             ELSEIF str[n]=".";    float:=TRUE
  943.             ELSE number:=FALSE
  944.             n++
  945.         ENDWHILE
  946.     ELSE number:=FALSE
  947. ENDPROC number,float
  948.  
  949. PROC ComputeMacro(first:PTR TO data,macro:PTR TO macro)
  950.     DEF    line:PTR TO mline,name[64]:STRING,pos,len,npos
  951.     DEF    value
  952.     line:=macro.mline
  953.     WHILE line
  954.         pos:=0
  955.         len:=StrLen(line.data)
  956. //        pos:=Crop(line.data,pos,len)
  957.         value:=0
  958.         WHILE (npos:=GetName(name,line.data,pos,len))>pos
  959.             SELECT TRUE
  960.             CASE StrCmp(name,'TAG_USER');    value|=$80000000
  961.             DEFAULT
  962.             ENDSELECT
  963.         ENDWHILE
  964.         line:=.next
  965.         CtrlC()
  966.     ENDWHILE
  967. ENDPROC
  968.