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