home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / PdSrc / FD2Module.e < prev    next >
Encoding:
Text File  |  1996-08-29  |  5.7 KB  |  205 lines
  1. /*
  2.  
  3. fd2module V1.0
  4. Alex McCracken Mar 1994
  5.  
  6. This program is heavily based on Wouter van Oortmerssen's pragma2module.
  7. In fact about 90% of the code belongs to Wouter, so I claim no credit for
  8. this. However, since Wouter's praga2module works very well for files in
  9. the correct format, I must state that if this fails it is most probably my
  10. fault.  You may use this program as you see fit, however should it fail and
  11. eat your dog, cause your telly to explode, or cause any problems
  12. what-so-ever, I will not be held responsible.  In other word use this at
  13. your own risk.  I have made every effort to ensure it works, but I cannot
  14. guarantee to have found all the niggly little ones that plauge almost all
  15. programs.
  16.  
  17. Usage
  18.  
  19. The program in invoked by typing (CLI only):
  20.  
  21.     fd2module <libname>
  22.  
  23. where libname is the name of the fd file minus the _lib.fd extension.
  24. This will produce a file <libname>.m .  At the moment the program echos the
  25. fd file as it reads it, but this may change in a future release.  You will
  26. need to give the program the name of the library explicitly, again this may
  27. change.
  28.  
  29. Distribution
  30.  
  31. This may be distributed by any means fit. However I retain the right to update
  32.  the package without informing anyone.  This distribution should contain:
  33.     fd2module        The executable
  34.     fd2module.doc        This document
  35.  
  36. Reaching me
  37.  
  38. I can be reached in the following ways:
  39.  
  40. Snail Mail:
  41.     Alex McCracken
  42.     11 Charles Street
  43.     Kilmarnock
  44.     Ayrshire
  45.     KA1 2DX
  46.     Scotland
  47.  
  48. Internet email:
  49.     mccracal@dcs.gla.ac.uk
  50.  
  51. I only use my email account during term time so over the summer it is probally
  52. best to write to me by snail mail.  The email address should remain valid until
  53. summer '95.
  54.  
  55. */
  56.  
  57. /* FD2Module
  58.    convert a library fd file to an E module.
  59.    Usage: fd2module <file>
  60.    converts <file_lib.fd> to <file.m>                                  */
  61.    
  62. ENUM INPUT_ERROR=10,OUTPUT_ERROR,FORMAT_ERROR
  63.  
  64. DEF cfh,efh,eof,done,
  65.     gotbase=FALSE,
  66.     public=TRUE,
  67.     offset=30,
  68.     cfile[200]:STRING,
  69.     efile[200]:STRING,
  70.     cstring[200]:STRING
  71.  
  72. PROC main()
  73.   StrCopy(cfile,arg,ALL)
  74.   StrAdd(cfile,'_lib.fd',ALL)
  75.   StrCopy(efile,arg,ALL)
  76.   StrAdd(efile,'.m',ALL)
  77.   WriteF('Amiga E FD2Module\nconverting: "\s" to "\s"\n',cfile,efile)
  78.   IF (cfh:=Open(cfile,OLDFILE))=0 THEN closeall(INPUT_ERROR)
  79.   IF (efh:=Open(efile,NEWFILE))=0 THEN closeall(OUTPUT_ERROR)
  80.   REPEAT
  81.     eof:=ReadStr(cfh,cstring)
  82.     done:=convert(cstring)
  83.   UNTIL eof OR done
  84.   WriteF('last offset: -\d\n',offset)
  85.   Out(efh,$FF)
  86.   WriteF('Done.\n')
  87.   closeall(0)
  88. ENDPROC
  89.  
  90. PROC closeall(er)
  91.   IF cfh<>0 THEN Close(cfh)
  92.   IF efh<>0 THEN Close(efh)
  93.   SELECT er
  94.     CASE INPUT_ERROR;  WriteF('Could not open input file!\n')
  95.     CASE OUTPUT_ERROR; WriteF('Could not open output file!\n')
  96.     CASE FORMAT_ERROR; WriteF('Function definition file format error!\n')
  97.   ENDSELECT
  98.   CleanUp(er)
  99. ENDPROC
  100.  
  101. /* format of line to convert:
  102.    ##base _<Basename>
  103.      or
  104.    ##bias <offset>
  105.      or
  106.    ##public
  107.      or
  108.    ##private
  109.      or
  110.    ##end
  111.      or
  112.    * <comment>
  113.      or
  114.    <funcname>(<paramlist>)(<reglist>)*/
  115.  
  116. PROC convert(str)
  117. DEF    pos,pos2,off2,len,narg,a,empty,dstr[50]:STRING,basestr[50]:STRING,
  118.     funcstr[50]:STRING,regstr[20]:STRING,libstr[50]:STRING,
  119.     tstr[80]:STRING,t2str[80]:STRING,t3str[80]:STRING,reg,check
  120.   MidStr(tstr,str,TrimStr(str)-str,ALL)
  121.   LowerStr(tstr)
  122.   WriteF('\s\n',str)
  123.   IF StrCmp(tstr,'##base ',STRLEN) OR StrCmp(tstr,'##base\t',STRLEN)
  124.     pos:=STRLEN
  125.     pos2:=InStr(tstr,'_',0)
  126.     IF pos2=-1 THEN closeall(FORMAT_ERROR)
  127.     IF gotbase=FALSE
  128.       gotbase:=TRUE
  129.       MidStr(basestr,str,(pos2+1),ALL)
  130.       LowerStr(basestr)
  131.       WriteF('Base will be: \s\n',basestr)
  132.       WriteF('Correct name of this library (with the ".library" or ".device"):\n>')
  133.       ReadStr(stdout,libstr)
  134.       Write(efh,["EM","OD",6]:INT,6)
  135.       Write(efh,libstr,EstrLen(libstr)+1)
  136.       Write(efh,basestr,EstrLen(basestr)+1)
  137.     ENDIF
  138.   ELSEIF StrCmp(tstr,'##bias ',STRLEN) OR StrCmp(tstr,'##bias\t',STRLEN)
  139.     pos:=STRLEN
  140.     MidStr(t2str,tstr,pos,ALL)
  141.     pos2:=TrimStr(t2str)
  142.     MidStr(t3str,t2str,pos2-t2str,ALL)
  143.     off2:=Val(t3str,NIL)
  144.     IF off2=0 THEN closeall(FORMAT_ERROR)
  145.     WHILE off2<>offset
  146.       Write(efh,'Dum',3)                     /* "empty function slots" */
  147.       Out(efh,16)
  148.       IF offset>off2 THEN closeall(FORMAT_ERROR)
  149.       offset:=offset+6
  150.     ENDWHILE
  151.   ELSEIF StrCmp(tstr,'##private',ALL)
  152.     public:=FALSE
  153.   ELSEIF StrCmp(tstr,'##public',ALL)
  154.     public:=TRUE
  155.   ELSEIF StrCmp(tstr,'##end',ALL)
  156.     RETURN TRUE
  157.   ELSEIF StrCmp(tstr,'*',STRLEN)
  158.     NOP
  159.   ELSE
  160.     IF public
  161.       pos:=0
  162.       pos2:=InStr(str,'(',pos)
  163.       IF pos2=-1 THEN closeall(FORMAT_ERROR)
  164.       MidStr(funcstr,str,pos,pos2-pos)
  165.       IF funcstr[0]>="a" THEN funcstr[0]:=funcstr[0]-32
  166.       IF funcstr[1]<"a" THEN funcstr[1]:=funcstr[1]+32
  167.       Write(efh,funcstr,EstrLen(funcstr))
  168.       pos:=pos2+1
  169.       pos2:=InStr(str,'(',pos)
  170.       IF pos2=-1 THEN closeall(FORMAT_ERROR)
  171.       narg:=0
  172.       MidStr(dstr,str,pos2+1,ALL)
  173.       UpperStr(dstr)
  174.       WHILE StrCmp(dstr,')',1)=FALSE
  175.         IF EstrLen(dstr)<2 THEN closeall(FORMAT_ERROR)
  176.         MidStr(regstr,dstr,0,2)
  177.         IF StrCmp(regstr,'D',1) OR StrCmp(regstr,'A',1)
  178.           IF StrCmp(regstr,'D',1)
  179.             reg:=0
  180.           ELSEIF StrCmp(regstr,'A',1)
  181.             reg:=8
  182.           ENDIF
  183.           MidStr(regstr,regstr,1,ALL)
  184.           reg:=reg+Val(regstr,{check})
  185.           IF check<1 THEN closeall(FORMAT_ERROR)
  186.         ELSE
  187.           closeall(FORMAT_ERROR)
  188.         ENDIF
  189.         MidStr(dstr,dstr,2,ALL)
  190.         IF StrCmp(dstr,',',1) OR StrCmp(dstr,'/',1)
  191.           MidStr(dstr,dstr,1,ALL)
  192.         ENDIF
  193.         Out(efh,reg)
  194.         INC narg
  195.       ENDWHILE
  196.       IF narg=0 THEN Out(efh,16)
  197.       offset:=offset+6
  198.     ELSE
  199.       Write(efh,'Dum',3)
  200.       Out(efh,16)
  201.       offset:=offset+6
  202.     ENDIF
  203.   ENDIF
  204. ENDPROC FALSE
  205.