home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / ACE / utils / fd2bmap / fd2bmap.b < prev    next >
Text File  |  1994-10-23  |  7KB  |  340 lines
  1. REM
  2. REM FD2BMAP Library DestDir
  3. REM
  4. REM    by Harald Schneider
  5. REM
  6. REM    Converts FD-File to a ACE-BMAP File like Commodores ConvertFD.
  7. REM
  8. REM    Example: FD2BMAP l/dos RAM: reads l/dos_lib.fd and creates RAM:dos.bmap
  9. REM
  10. REM    Differences to ConvertFD:
  11. REM           - #private marked entries are skipped
  12. REM         - Unlike AmigaBasic ACE allows the use of A5 for parameters so
  13. REM           functions uses A5 are not ignored
  14. REM    Name collision of ACE keywords and library calls are handled like
  15. REM    ConvertFD (Read --> xRead)
  16.  
  17. REM Modified by David Benn: 10th,17th January, 10th August 1994,
  18. REM                15th October 1994
  19.  
  20. ver_str$ = "$VER: FD2BMAP V1.1 (15.10.94)"
  21.  
  22. DECLARE SUB Assert(FTxt&)
  23. DECLARE SUB TRIM$(Txt$)
  24.  
  25. CONST Num_Keys=8    :REM Number of keywords in collision list - 1
  26.  
  27. REM Errornumbers
  28. CONST Err_No_Offset=0
  29. CONST Err_Func_Name=1
  30. CONST Err_Para_Kl_a=2
  31. CONST Err_Para_Kl_z=3
  32. CONST Err_Func_Kl_a=4
  33. CONST Err_Func_Kl_z=5
  34. CONST Err_Illegal_Reg=6
  35. CONST Err_Illegal_Nr=7
  36. CONST Err_Sep=8
  37. CONST Err_Reg_List=9
  38. CONST NumErrs=9
  39.  
  40. DIM KeyWords$(Num_Keys),FailTxt$(NumErrs)
  41.  
  42. REM Error descriptions
  43. FailTxt$(Err_No_Offset)="Missing ##bias"
  44. FailTxt$(Err_Func_Name)="Missing function name"
  45. FailTxt$(Err_Para_Kl_a)="'(' of parameter list expected"
  46. FailTxt$(Err_Para_Kl_z)="')' of parameter list expected"
  47. FailTxt$(Err_Func_Kl_a)="'(' of function list expected"
  48. FailTxt$(Err_Func_Kl_z)="')' of function list expected"
  49. FailTxt$(Err_Illegal_Reg)="Illegal register type (Ax or Dx)"
  50. FailTxt$(Err_Illegal_Nr)="Illegal register number (0-7)"
  51. FailTxt$(Err_Sep)="',' or '/' between register expected"
  52. FailTxt$(Err_Reg_List)="register list currupted"
  53.  
  54.  
  55. IF ARGCOUNT<>2 THEN
  56.     PRINT "usage: ";ARG$(0);" libraryname DestinationDir"
  57.     PRINT "   eg: ";ARG$(0);" sys:fd/2.0/asl ACEbmaps:"
  58.     STOP
  59. END IF
  60.  
  61. FName$=ARG$(1)
  62. DestDir$=ARG$(2)
  63.  
  64. Source$=FName$+"_LIB.FD"
  65. OPEN "i",1,Source$
  66. IF HANDLE(1)=0 THEN
  67.     PRINT "Cannot open ";Source$
  68.    STOP
  69. END IF
  70.  
  71. Dest$=FName$
  72. i&=LEN(FName$)
  73. WHILE i&<>0
  74.     ch$=MID$(FName$,i&,1)
  75.     IF ch$=":" OR ch$="/" THEN
  76.         Dest$=MID$(FName$,i&+1)
  77.         i&=0
  78.     ELSE
  79.         --i&
  80.     END IF
  81. WEND
  82.  
  83. IF DestDir$<>CHR$(34)+CHR$(34) THEN
  84.     ch$=RIGHT$(DestDir$,1)
  85.     IF ch$<>"/" AND ch$<>":" THEN
  86.         DestDir$=DestDir$
  87.     END IF
  88. ELSE
  89.     DestDir$=""
  90. END IF
  91. Dest$=DestDir$+Dest$+".BMAP"
  92. OPEN "o",2,Dest$
  93. IF HANDLE(2)=0 THEN
  94.     PRINT "Cannot open ";Dest$
  95.     CLOSE 1
  96.     STOP
  97. END IF
  98.  
  99. FOR i%=0 TO Num_Keys
  100.     READ KeyWords$(i%)
  101. NEXT i%
  102.  
  103. DATA "Close","Exit","Input","Open","Read","Translate","Wait","Write","Output"
  104.  
  105.  
  106. ON BREAK GOTO quit.prg
  107. BREAK ON
  108.  
  109. print
  110. print "Creating ";Dest$;"..."
  111. print
  112.  
  113. FuncOffset%=-1   :REM Holds the Offset for each library call
  114. WriteFlag%=1     :REM Switch that enables/disable writing .FD-function in bmap
  115. NumLine&=0          :REM number read .FD lines
  116. WHILE NOT EOF(1)
  117.     LINE INPUT #1,FD$
  118.     ++NumLine&
  119.     IF LEN(FD$)>0 THEN
  120.         IF LEFT$(FD$,1)<>"*" THEN
  121.             IF LEFT$(FD$,2)="##" THEN
  122.                 FD$=UCASE$(FD$)
  123.                 IF LEFT$(FD$,7)="##BIAS " THEN
  124.                     REM functionbase
  125.                     FuncOffset%=-VAL(TRIM$(MID$(FD$,7)))
  126.                 ELSE
  127.                     IF LEFT$(FD$,8)="##PUBLIC" THEN
  128.                        REM enable writing
  129.                         WriteFlag%=1
  130.                     ELSE
  131.                         IF LEFT$(FD$,9)="##PRIVATE" THEN
  132.                             rem disable writing
  133.                             REM WriteFlag%=0
  134.                         END IF
  135.                     END IF
  136.                 END IF
  137.             ELSE
  138.                 IF FuncOffset%=-1 THEN
  139.                     Assert(Err_No_Offset)
  140.                 END IF
  141.                 IF WriteFlag% THEN
  142.                     REM then it must be a library function
  143.                     REM checking if the syntax is ok
  144.                     pop1&=INSTR(FD$,"(")
  145.                     IF pop1&=1 THEN
  146.                         Assert(Err_Func_Name)
  147.                     END IF
  148.                     IF pop1&=0 THEN
  149.                         Assert(Err_Para_Kl_a)
  150.                     END IF
  151.                     pop2&=INSTR(FD$,")")
  152.                     IF pop2&=0 THEN
  153.                         Assert(Err_Para_Kl_z)
  154.                     END IF
  155.                     IF pop2&<pop1& THEN
  156.                         Assert(Err_Para_Kl_a)
  157.                     END IF
  158.  
  159.                     pof1&=INSTR(pop1&+1,FD$,"(")
  160.                     pof2&=INSTR(pop2&+1,FD$,")")
  161.  
  162.                     '..No 2nd set of parentheses (for regs)?
  163.                     '..(eg. Forbid() in Extras/FD1.3)
  164.                     IF pof1&=0 and pof2&=0 THEN get_name
  165.  
  166.                     '..Check for errors if 2nd set of 
  167.                     '..parentheses do exist.
  168.                     IF pof1&=0 THEN
  169.                         Assert(Err_Func_Kl_a)
  170.                     END IF
  171.                     IF pof1&<pop2& THEN
  172.                         Assert(Err_Para_Kl_z)
  173.                     END IF
  174.                     IF pof2&=0 THEN
  175.                         Assert(Err_Func_Kl_z)
  176.                     END IF
  177.                     IF pof2&<pof1& THEN
  178.                         Assert(Err_Func_Kl_a)
  179.                     END IF
  180.  
  181.  
  182.                 get_name:
  183.  
  184.                     REM isolate name of library function
  185.                     FuncName$=TRIM$(LEFT$(FD$,pop1&-1))
  186.                     IF FuncName$="" THEN
  187.                         Assert(Err_Func_Name)
  188.                     END IF
  189.  
  190.                     '..Registers specified?
  191.                     IF pof1&=0 and pof2&=0 THEN
  192.                       Regs$=""
  193.                     ELSE
  194.                         Regs$=UCASE$(TRIM$(MID$(FD$,pof1&+1, ~
  195.                                pof2&-pof1&-1)))
  196.                     END IF
  197.  
  198.                     REM remove all spaces
  199.                     IF Regs$<>"" THEN
  200.                       i&=2:ln&=LEN(Regs$)
  201.                       WHILE i&<ln&
  202.                         IF MID$(Regs$,i&,1)=" " THEN
  203.                           Regs$=LEFT$(Regs$,i&-1)+ ~ 
  204.                                 MID$(Regs$,i&+1)
  205.                           --ln&
  206.                         ELSE
  207.                           ++i&
  208.                         END IF
  209.                       WEND
  210.                     END IF
  211.  
  212.                     print FuncName$;tab(25);Regs$
  213.  
  214.                     RegOk&=1 :REM no unsupported register 
  215.                          :REM specified ?
  216.                     RegList$="" :REM used registers
  217.                     REM examine register list
  218.  
  219.                     '..If no register list given -> just 
  220.                     '..write other info to bmap file.
  221.                     if pof1&=0 and pof2&=0 then write_bmap
  222.  
  223.                     WHILE Regs$<>"" AND RegOk&
  224.                         IF LEN(Regs$)>=2 THEN
  225.                             ch$=LEFT$(Regs$,1)
  226.                             IF ch$="D" THEN
  227.                                 RegNum&=1
  228.                             ELSE
  229.                                 IF ch$="A" THEN
  230.                                     RegNum&=9
  231.                                 ELSE
  232.                                     Assert(Err_Illegal_Reg)
  233.                                 END IF
  234.                             END IF
  235.                             we&=VAL(MID$(Regs$,2,1))
  236.                             IF we&>7 THEN
  237.                                 Assert(Err_Illegal_Nr)
  238.                             END IF
  239.                             RegNum&=RegNum&+we&
  240.                             IF RegNum&>14 THEN
  241.                                 PRINT "Warning: ";FuncName$;" requires register(s) ";
  242.                                 PRINT "ACE doesn't support register. Function ignored!"
  243.                                 RegOk&=0
  244.                        END IF
  245.                             RegList$=RegList$+CHR$(RegNum&)
  246.                             IF LEN(Regs$)>=3 THEN
  247.                                 ch$=MID$(Regs$,3,1)
  248.                                 IF ch$<>"," AND ch$<>"/" THEN
  249.                                     Assert(Err_Sep)
  250.                                 END IF
  251.                                Regs$=MID$(Regs$,4)
  252.                             ELSE
  253.                                 Regs$=""
  254.                             END IF
  255.                         ELSE
  256.                             Assert(Err_Reg_List)
  257.                         END IF
  258.                     WEND
  259.  
  260.  
  261.                 write_bmap:
  262.  
  263.                     REM write to .BMAP file if regs ok
  264.                                IF RegOk& THEN
  265.                       REM check & eliminate name collisions
  266.                       FOR i%=0 TO Num_Keys
  267.                         IF FuncName$=KeyWords$(i%) THEN
  268.                           FuncName$="x" + FuncName$
  269.                           i%=NumKeys
  270.                         END IF
  271.                       NEXT i%
  272.  
  273.                       REM make offset writeable 
  274.                       Off$="  ":Off&=@Off$
  275.                       POKEW Off&,FuncOffset%
  276.                       PRINT #2,FuncName$;CHR$(0); ~
  277.                            CHR$(PEEK(Off&)); ~
  278.                            CHR$(PEEK(Off&+1));
  279.                       IF RegList$<>"" THEN
  280.                         PRINT #2,RegList$;
  281.                       END IF
  282.                       PRINT #2,CHR$(0);
  283.                     END IF
  284.                 END IF
  285.                 FuncOffset%=FuncOffset%-6
  286.             END IF
  287.         END IF
  288.     END IF
  289. WEND
  290.  
  291. '..finish up
  292. print
  293. print Dest$;" created."
  294. print
  295.  
  296. CLOSE 2
  297. CLOSE 1
  298. STOP
  299.  
  300. quit.prg:
  301.   print "***Break: ";ARG$(0);" terminating."
  302.   CLOSE 2
  303.   CLOSE 1
  304.   KILL Dest$
  305.   print "Destination file removed."
  306.   STOP
  307.  
  308. SUB Assert(FTxt&)
  309.     SHARED NumLine&,FailTxt$
  310.     PRINT "ERROR in line";NumLine&;FailTxt$(FTxt&)
  311.     CLOSE 2
  312.     CLOSE 1
  313.      STOP
  314. END SUB
  315.  
  316. SUB TRIM$(st$)
  317.     SHORTINT ln
  318.     LONGINT StStart,AdrAnf,AdrEnd
  319.     ln=LEN(st$)
  320.     IF ln<>0 THEN
  321.         StStart=SADD(st$)
  322.        AdrAnf=StStart: AdrEnd=StStart+ln-1
  323.  
  324.        WHILE PEEK(AdrAnf)=32 AND AdrAnf<=AdrEnd
  325.             ++AdrAnf
  326.         WEND
  327.  
  328.         WHILE PEEK(AdrEnd)=32 AND AdrEnd>AdrAnf
  329.            --AdrEnd
  330.         WEND
  331.         IF AdrAnf>AdrEnd THEN
  332.             TRIM$=""
  333.         ELSE
  334.             TRIM$=MID$(st$,AdrAnf-StStart+1,AdrEnd-AdrAnf+1)
  335.        END IF
  336.     ELSE
  337.         TRIM$=""
  338.     END IF
  339. END SUB
  340.