home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / ACE / utils / a-a / a-a.b next >
Text File  |  1994-10-23  |  10KB  |  325 lines
  1. {From XRACTON@FULLERTON.EDU Thu Jun 24 00:38:10 1993
  2. Return-Path: <XRACTON@FULLERTON.EDU>
  3. Received: from CCVAX.FULLERTON.EDU (csu.Fullerton.EDU) by leven.appcomp.utas.edu.au (4.1/SMI-4.1)
  4.     id AA05310; Thu, 24 Jun 93 00:37:44 EST
  5. Received: from FULLERTON.EDU by FULLERTON.EDU (PMDF #2446 ) id
  6.  <01GZPKD4PQ3Q002QFT@FULLERTON.EDU>; Wed, 23 Jun 1993 07:36:05 PST
  7. Date: 23 Jun 1993 07:36:05 -0800 (PST)
  8. From: ROLAND ACTON <XRACTON@FULLERTON.EDU>
  9. Subject: A-A program code
  10. To: dbenn@leven.appcomp.utas.edu.au
  11. Message-Id: <01GZPKD4PZQW002QFT@FULLERTON.EDU>
  12. X-Vms-To: IN%"dbenn@leven.appcomp.utas.edu.au"
  13. Mime-Version: 1.0
  14. Content-Transfer-Encoding: 7BIT
  15. Status: OR}
  16.  
  17. Rem *** AMOS to ACE (program)
  18. Rem ***
  19. Rem *** FUNCTION:
  20. Rem *** Converts (some) AMOS BASIC commands to ACE BASIC.
  21. Rem ***
  22. Rem *** REVISION HISTORY:
  23. Rem *** Version 1.0: Roland Acton (xracton@ccvax.fullerton.edu)
  24. Rem ***
  25. Rem *** BUGS:
  26. Rem *** String constants may accidentally be converted if they match
  27. Rem *** with A-A's templates.
  28. Rem *** The "then" version of AMOS's IF statement will be improperly
  29. Rem *** converted and generate an error message from ACE.
  30.  
  31. DEFINT a-z
  32. STRING buffer$ size 256, a$ size 2, holder$ size 2, output$ size 256
  33. STRING checker$ size 2, infile$ size 256
  34.  
  35. Library dos
  36. Declare Function xRead& Library dos
  37. Declare Function xWrite& Library dos
  38.  
  39. IF ARGCOUNT<>2 THEN
  40.    Print "AMOS to ACE"
  41.    Print "V1.0 by Roland Acton (xracton@ccvax.fullerton.edu) - June 1993"
  42.    Print "Syntax: AMOStoACE <source-file> <destination-file>"
  43.    STOP
  44. END IF
  45. Const CONVBEGINNUM=21
  46. Const CONVANYNUM=10
  47. Dim CONVBEGINFROM$(CONVBEGINNUM),CONVBEGINTO$(CONVBEGINNUM)
  48. Dim CONVANYFROM$(CONVANYNUM),CONVANYTO$(CONVANYNUM)
  49. Dim VARIABLE$(9)
  50. Gosub TEMPLATES
  51. OPEN "I", #1, ARG$(1)
  52. OPEN "O", #2, ARG$(2)
  53. BUFFER$=""
  54. AMOSCODE=0
  55. Print #2,"DEFLNG a-z"+Chr$(10);
  56. REMAINING=xRead(Handle(1),Varptr(INFILE$),256&)
  57. INFILEOFFSET=0
  58. BEGINNINGOFLINE=0
  59. MAINLOOP:
  60. INSIDETEXT=0
  61. BUFFEROFFSET=0
  62. A=Asc(Right$(BUFFER$,1))
  63. While(((Eof(1)<>-1) or(REMAINING>0)) and(A<>10))
  64.    BEGINNINGOFLINE=1
  65.    A=Peek(Varptr(INFILE$)+INFILEOFFSET)
  66.    ++INFILEOFFSET
  67.    --REMAINING
  68.    IF ((A=58) and(INSIDETEXT=0)) THEN
  69.       If Right$(BUFFER$,1)<>" " THEN
  70.          Poke Varptr(BUFFER$)+BUFFEROFFSET,58
  71.          ++BUFFEROFFSET
  72.       End If
  73.       Poke Varptr(BUFFER$)+BUFFEROFFSET,10
  74.       A=10
  75.    Else 
  76.       IF A=34 THEN
  77.          INSIDETEXT=1-INSIDETEXT
  78.       END IF
  79.       Poke Varptr(BUFFER$)+BUFFEROFFSET,A
  80.    END IF
  81.    ++BUFFEROFFSET
  82.    Poke Varptr(BUFFER$)+BUFFEROFFSET,0
  83.    IF REMAINING=0 THEN
  84.       REMAINING=xRead(Handle(1),Varptr(INFILE$),256&)
  85.       INFILEOFFSET=0
  86.    END IF
  87. Wend 
  88. IF ((BUFFER$="") and(Eof(1)=-1)) THEN
  89.    Gosub FINALIZATION
  90.    STOP
  91. END IF
  92. Rem *** "Copy and change" isn't usually a good idea, but in this
  93. Rem *** case it produces the fastest object code.
  94. IF BEGINNINGOFLINE=1 THEN
  95.   BEGINNINGOFLINE=0
  96.   SPACEKLUDGE:
  97.   If Left$(BUFFER$,1)=" " THEN
  98.     xWrite(Handle(2),Varptr(BUFFER$),1)
  99.     BUFFER$=Mid$(BUFFER$,2)
  100.     Goto SPACEKLUDGE
  101.   End If
  102.   Gosub BEFORECHECK
  103.   For C=1 To CONVBEGINNUM
  104.      For Z=1 To 9
  105.         VARIABLE$(Z)=""
  106.      Next 
  107.      SUCCESS=1
  108.      BUFFERSTEP=1
  109.      For Z=1 To Len(CONVBEGINFROM$(C))
  110.         IF  Mid$(CONVBEGINFROM$(C),Z,1)="\" THEN
  111.            VARUSED=Val(Mid$(CONVBEGINFROM$(C),Z+1,1))
  112.            HOLDER$=Mid$(CONVBEGINFROM$(C),Z+2,1)
  113.            PARNUM=0
  114.            IF  HOLDER$=")" THEN
  115.               A=Instr(BUFFERSTEP,BUFFER$,")")
  116.               B=INSTR(BUFFERSTEP,BUFFER$,"(")
  117.               While((B>0) and(B<A))
  118.                  B=INSTR(B+1,BUFFER$,"(")
  119.                  PARNUM=PARNUM+1
  120.               Wend 
  121.            Else 
  122.               A=INSTR(BUFFERSTEP,BUFFER$,HOLDER$)
  123.            END IF
  124.            While PARNUM>0
  125.               A=Instr(A+1,BUFFER$,")")
  126.               PARNUM=PARNUM-1
  127.            Wend 
  128.            B=Instr(BUFFERSTEP,BUFFER$,Mid$(CONVBEGINFROM$(C),Z+3,1))
  129.            IF ((A>0) and((B=0) or(A<=B))) THEN
  130.               VARIABLE$(VARUSED)=VARIABLE$(VARUSED)+Mid$(BUFFER$,BUFFERSTEP,A-BUFFERSTEP)
  131.               BUFFERSTEP=A
  132.            Else 
  133.               SUCCESS=0
  134.               Z=Len(CONVBEGINFROM$(C))
  135.            END IF
  136.            Z=Z+3
  137.         Else 
  138.            IF  Mid$(CONVBEGINFROM$(C),Z,1)<>Mid$(BUFFER$,BUFFERSTEP,1) THEN
  139.               SUCCESS=0
  140.               Z=Len(CONVBEGINFROM$(C))
  141.            END IF
  142.         END IF
  143.         ++BUFFERSTEP
  144.      Next 
  145.      IF SUCCESS=1 THEN
  146.         OUTPUT$=""
  147.         For Z=1 To Len(CONVBEGINTO$(C))
  148.            CHECKER$=Mid$(CONVBEGINTO$(C),Z,1)
  149.            IF  CHECKER$="\" THEN
  150.               OUTPUT$=OUTPUT$+VARIABLE$(Val(Mid$(CONVBEGINTO$(C),Z+1,1)))
  151.               Z=Z+1
  152.            Else 
  153.               OUTPUT$=OUTPUT$+CHECKER$
  154.            END IF
  155.         Next 
  156.         xWrite(Handle(2),Varptr(OUTPUT$),Len(OUTPUT$))
  157.         BUFFER$=Mid$(BUFFER$,BUFFERSTEP)
  158.         C=CONVBEGINNUM
  159.         BEGINNINGOFLINE=1
  160.      END IF
  161.   Next 
  162.   Gosub AFTERCHECK
  163.   Goto MAINLOOP
  164. END IF
  165. Gosub BEFORECHECK
  166. For C=1 To CONVANYNUM
  167.    For Z=1 To 9
  168.       VARIABLE$(Z)=""
  169.    Next 
  170.    SUCCESS=1
  171.    BUFFERSTEP=1
  172.    For Z=1 To Len(CONVANYFROM$(C))
  173.       IF  Mid$(CONVANYFROM$(C),Z,1)="\" THEN
  174.          VARUSED=Val(Mid$(CONVANYFROM$(C),Z+1,1))
  175.          HOLDER$=Mid$(CONVANYFROM$(C),Z+2,1)
  176.          PARNUM=0
  177.          IF  HOLDER$=")" THEN
  178.             A=Instr(BUFFERSTEP,BUFFER$,")")
  179.             B=INSTR(BUFFERSTEP,BUFFER$,"(")
  180.             While((B>0) and(B<A))
  181.                B=INSTR(B+1,BUFFER$,"(")
  182.                PARNUM=PARNUM+1
  183.             Wend 
  184.          Else 
  185.             A=INSTR(BUFFERSTEP,BUFFER$,HOLDER$)
  186.          END IF
  187.          While PARNUM>0
  188.             A=Instr(A+1,BUFFER$,")")
  189.             PARNUM=PARNUM-1
  190.          Wend 
  191.          B=Instr(BUFFERSTEP,BUFFER$,Mid$(CONVANYFROM$(C),Z+3,1))
  192.          IF ((A>0) and((B=0) or(A<=B))) THEN
  193.             VARIABLE$(VARUSED)=VARIABLE$(VARUSED)+Mid$(BUFFER$,BUFFERSTEP,A-BUFFERSTEP)
  194.             BUFFERSTEP=A
  195.          Else 
  196.             SUCCESS=0
  197.             Z=Len(CONVANYFROM$(C))
  198.          END IF
  199.          Z=Z+3
  200.       Else 
  201.          IF  Mid$(CONVANYFROM$(C),Z,1)<>Mid$(BUFFER$,BUFFERSTEP,1) THEN
  202.             SUCCESS=0
  203.             Z=Len(CONVANYFROM$(C))
  204.          END IF
  205.       END IF
  206.       ++BUFFERSTEP
  207.    Next 
  208.    IF SUCCESS=1 THEN
  209.       OUTPUT$=""
  210.       For Z=1 To Len(CONVANYTO$(C))
  211.          CHECKER$=Mid$(CONVANYTO$(C),Z,1)
  212.          IF  CHECKER$="\" THEN
  213.             OUTPUT$=OUTPUT$+VARIABLE$(Val(Mid$(CONVANYTO$(C),Z+1,1)))
  214.             Z=Z+1
  215.          Else 
  216.             OUTPUT$=OUTPUT$+CHECKER$
  217.          END IF
  218.       Next 
  219.       xWrite(Handle(2),Varptr(OUTPUT$),Len(OUTPUT$))
  220.       BUFFER$=Mid$(BUFFER$,BUFFERSTEP)
  221.       C=CONVANYNUM
  222.    END IF
  223. Next 
  224. Gosub AFTERCHECK
  225. IF (Right$(BUFFER$,1)=Chr$(10)) THEN
  226.    xWrite(Handle(2),Varptr(BUFFER$),1)
  227.    BUFFER$=Mid$(BUFFER$,2)
  228. END IF
  229. Goto MAINLOOP
  230. FINALIZATION:
  231. Close 1
  232. Close 2
  233. Library Close dos
  234. Return
  235. BEFORECHECK:
  236. IF  Left$(BUFFER$,14)="Rem Begin AMOS" THEN
  237.    AMOSCODE=1
  238. END IF
  239. IF  Left$(BUFFER$,12)="Rem End AMOS" THEN
  240.    AMOSCODE=0
  241.    BUFFER$="Rem AMOS"+Chr$(10)
  242. END IF
  243. IF  AMOSCODE=1 THEN
  244.    BUFFER$=Chr$(10)
  245. END IF
  246. IF  Left$(BUFFER$,7)="Rem ACE" THEN
  247.    xWrite(Handle(2),Varptr(BUFFER$)+7,Len(BUFFER$)-7)
  248.    BUFFER$=Chr$(10)
  249. END IF
  250. Return 
  251. AFTERCHECK:
  252. Return 
  253. TEMPLATES:
  254. Rem *** FROM templates contain either case-sensitive "constants" or
  255. Rem *** the "variable" character "\". The format of the embedded
  256. Rem *** variable flag is:
  257. Rem *** \<variable number><success-char><fail-char>
  258. Rem *** If the <success-char> and <fail-char> are the same, the
  259. Rem *** match will always be successful.
  260. Rem *** TO templates contain either constants or the variable
  261. Rem *** character followed immediately by the variable number.
  262. CONVBEGINFROM$(1)="Inc \1"+Chr$(10)+Chr$(10)
  263. CONVBEGINTO$(1)="++\1"+Chr$(10)
  264. CONVBEGINFROM$(2)="Dec \1"+Chr$(10)+Chr$(10)
  265. CONVBEGINTO$(2)="--\1"+Chr$(10)
  266. CONVBEGINFROM$(3)="Add \1,"+Chr$(10)+"\2"+Chr$(10)+Chr$(10)
  267. CONVBEGINTO$(3)="\1=\1+\2"+Chr$(10)
  268. CONVBEGINFROM$(4)="End If "
  269. CONVBEGINTO$(4)="END IF"
  270. CONVBEGINFROM$(5)="If\1"+Chr$(10)+Chr$(10)
  271. CONVBEGINTO$(5)="IF\1 THEN"+Chr$(10)
  272. CONVBEGINFROM$(6)="Do "+Chr$(10)
  273. CONVBEGINTO$(6)="REPEAT"+Chr$(10)
  274. CONVBEGINFROM$(7)="Loop "+Chr$(10)
  275. CONVBEGINTO$(7)="UNTIL 1=0"+Chr$(10)
  276. CONVBEGINFROM$(8)="Fix(\1)"+Chr$(10)
  277. CONVBEGINTO$(8)="FIX \1+1"
  278. CONVBEGINFROM$(9)="Say \1,"+Chr$(10)+"\2"+Chr$(10)+Chr$(10)
  279. CONVBEGINTO$(9)="SAY \1"+Chr$(10)
  280. CONVBEGINFROM$(10)="Open Out \1,"+Chr$(10)+"\2"+Chr$(10)+Chr$(10)
  281. CONVBEGINTO$(10)="OPEN "+Chr$(34)+"O"+Chr$(34)+", #\1, \2"+Chr$(10)
  282. CONVBEGINFROM$(11)="Open In \1,"+Chr$(10)+"\2"+Chr$(10)+Chr$(10)
  283. CONVBEGINTO$(11)="OPEN "+Chr$(34)+"I"+Chr$(34)+", #\1, \2"+Chr$(10)
  284. CONVBEGINFROM$(12)="Append \1,"+Chr$(10)+"\2"+Chr$(10)+Chr$(10)
  285. CONVBEGINTO$(12)="OPEN "+Chr$(34)+"A"+Chr$(34)+", #\1, \2"+Chr$(10)
  286. CONVBEGINFROM$(13)="Doke \1,"+Chr$(10)+"\2"+Chr$(10)+Chr$(10)
  287. CONVBEGINTO$(13)="POKEW \1,\2"+Chr$(10)
  288. CONVBEGINFROM$(14)="Loke \1,"+Chr$(10)+"\2"+Chr$(10)+Chr$(10)
  289. CONVBEGINTO$(14)="POKEL \1,\2"+Chr$(10)
  290. CONVBEGINFROM$(15)="Procedure \1["+Chr$(10)+"\2]"+Chr$(10)
  291. CONVBEGINTO$(15)="SUB \1(\2)"
  292. CONVBEGINFROM$(16)="Procedure \1"+Chr$(10)+Chr$(10)
  293. CONVBEGINTO$(16)="SUB \1"+Chr$(10)
  294. CONVBEGINFROM$(17)="End Proc"
  295. CONVBEGINTO$(17)="END SUB"
  296. CONVBEGINFROM$(18)="Proc \1["+Chr$(10)+"\2]"+Chr$(10)
  297. CONVBEGINTO$(18)="CALL \1(\2)"
  298. CONVBEGINFROM$(19)="Proc \1"+Chr$(10)+Chr$(10)
  299. CONVBEGINTO$(19)="CALL \1"+Chr$(10)
  300. CONVBEGINFROM$(20)="Set Buffer \1"+Chr$(10)+Chr$(10)
  301. CONVBEGINTO$(20)=Chr$(10)
  302. CONVBEGINFROM$(21)="Rename \1T"+chr$(10)+"o \2"+chr$(10)+chr$(10)
  303. CONVBEGINTO$(21)="NAME \1AS \2"+chr$(10)
  304. CONVANYFROM$(1)="Instr(\1,"+Chr$(10)+"\2,)\3)"+Chr$(10)
  305. CONVANYTO$(1)="INSTR(\3,\1,\2)"
  306. CONVANYFROM$(2)="Deek(\1)"+Chr$(10)
  307. CONVANYTO$(2)="PEEKW(\1)"
  308. CONVANYFROM$(3)="Leek(\1)"+Chr$(10)
  309. CONVANYTO$(3)="PEEKL(\1)"
  310. CONVANYFROM$(4)="Free"
  311. CONVANYTO$(4)="FRE(-1)"
  312. CONVANYFROM$(5)="Upper$(\1)"+Chr$(10)
  313. CONVANYTO$(5)="UCASE$(\1)"
  314. CONVANYFROM$(6)="Rnd(\1)"+Chr$(10)
  315. CONVANYTO$(6)="RND"
  316. CONVANYFROM$(7)="Hex$(\1,"+Chr$(10)+"\2)"+Chr$(10)
  317. CONVANYTO$(7)="HEX$(\1)"
  318. CONVANYFROM$(8)="Bin$(\1,"+Chr$(10)+"\2)"+Chr$(10)
  319. CONVANYTO$(8)="BIN$(\1)"
  320. CONVANYFROM$(9)="String$(\1,"+Chr$(10)+"\2)"+Chr$(10)
  321. CONVANYTO$(9)="STRING$(\2,\1)"
  322. CONVANYFROM$(10)="Lower$(\1)"+Chr$(10)
  323. CONVANYTO$(10)="LCASE$(\1)"
  324. Return 
  325.