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