home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / prog_oth / basicstp.lzh / BASICSTRIP / BASIC.STRIP < prev    next >
Encoding:
Text File  |  1991-08-16  |  10.3 KB  |  405 lines
  1. CLEAR ,35000&
  2. DIM Basic$(1000) 'maximun number of BASIC lines
  3. DIM Number%(100) 'maximum number of jump addresses
  4. DIM Col%(200)    'for multiple commands on lines
  5. WIDTH 80
  6.  
  7. Main:
  8.   FirstTime = 0
  9.   GOSUB Hello
  10.   GOSUB GetData
  11.   PRINT  "Checking for simple errors..."
  12.   GOSUB ErrorCheck
  13.   PRINT  "Checking for multiple statements on a line..."
  14.   GOSUB FindCol
  15.   PRINT  "Isolating jump labels..."
  16.   FOR j = 1 TO count  'find key words
  17.     GOSUB Isolate
  18.   NEXT
  19.   PRINT  "Sorting jump labels..."
  20.   GOSUB Sort
  21.   PRINT  "Making"; NumCount; "headers..."
  22.   GOSUB MakeHeader
  23.   PRINT  "Deleting line numbers..."
  24.   GOSUB DeleteLN
  25.   PRINT  "Changing jump labels...
  26.   GOSUB Change
  27.   PRINT  "Indenting loops..."
  28.   GOSUB Indent
  29.   PRINT  "Saving file to disk..."
  30.   GOSUB Savit
  31.   PRINT  "Done"
  32. END
  33.  
  34. GetData:  'read program into array
  35. INPUT "What file do you want to strip"; FileName$
  36.   IF FileName$ = "" THEN GetData
  37.   Newfile$ = FileName$ + ".S"
  38.   PRINT  "The revised program will be saved as "; Newfile$
  39.   PRINT 
  40.   INPUT "Do you want a hardcopy of the jump table to help in debugging"; Hard$
  41.   Hard$ = UCASE$(Hard$)
  42.   C$ = LEFT$(Hard$,1)
  43.   IF C$ = "Y" THEN Hard = 1
  44. OPEN FileName$ FOR INPUT AS #1
  45.   WHILE EOF(1) = 0
  46.     count = count + 1
  47.     LINE INPUT #1, Basic$(count)
  48.   WEND
  49.   CLOSE 1
  50.   PRINT  "  Read"; count; "lines..."
  51.   RETURN
  52.   
  53. Isolate: 'find key words  
  54.   Gt = Gs = Og = Th = Rm = Rs = 0
  55.   Gt = INSTR(Basic$(j),"GOTO")
  56.   Gs = INSTR(Basic$(j),"GOSUB")
  57.   Th = INSTR(Basic$(j),"THEN")
  58.   Rm = INSTR(Basic$(j),"RESUME")
  59.   Rs = INSTR(Basic$(j),"RESTORE")
  60.   IF Gt > 0 THEN  'for GOTO
  61.     Where = Gt + 4
  62.     GOSUB AddNumber
  63.   END IF
  64.   IF Gs > 0 THEN ' for GOSUB
  65.     Where = Gs + 5
  66.     GOSUB AddNumber
  67.   END IF
  68.   IF Th > 0 AND Gt = 0 AND Gs = 0 THEN 'for THEN
  69.     Where = Th + 4
  70.     GOSUB AddNumber
  71.   END IF
  72.   IF Rm > 0 THEN  'for GOTO
  73.     Where = Rm + 6
  74.     GOSUB AddNumber
  75.   END IF
  76.   IF Rs > 0 THEN  'for GOTO
  77.     Where = Rs + 7
  78.     GOSUB AddNumber
  79.   END IF
  80. RETURN
  81.  
  82. AddNumber: 'isolate jump labels
  83.   M$ = "1"
  84.   Add$ = ""
  85.   Long = LEN(Basic$(j))
  86.   WHILE M$ <= "9" AND Where <= Long
  87.     M$ = MID$(Basic$(j),Where,1)
  88.     IF M$ = ":" THEN M$ = "Z"  'break out of loop
  89.     IF M$ = "," THEN           'on goto-gosub reset
  90.       IF FirstTime = 0 THEN GOSUB FillArray ELSE RETURN
  91.       Add$ = ""
  92.     END IF
  93.     IF M$ >= "0" AND M$ <= "9" THEN Add$ = Add$ + M$
  94.     Where = Where + 1
  95.   WEND
  96.   IF FirstTime = 0 THEN GOSUB FillArray
  97.   RETURN
  98.  
  99. FillArray: 'keep track of jump labels
  100.   IF NumCount = 0 THEN
  101.     NumCount = 1
  102.     Number%(NumCount) = VAL(Add$)
  103.     RETURN
  104.   END IF
  105.   V = VAL(Add$)
  106.   NumFlag = 0
  107.   FOR k = 1 TO NumCount
  108.     IF V = Number%(k) THEN NumFlag = 1 'found a duplicate
  109.   NEXT
  110.   IF NumFlag = 0 THEN
  111.     NumCount = NumCount + 1
  112.     Number%(NumCount) = V
  113.   END IF
  114.   RETURN
  115.   
  116. Sort: 'sort labels by Shell-Metzner method
  117.     Divisor = INT(NumCount/2 + 1)
  118.  
  119. DoShell:
  120.   Divisor = INT(Divisor/2)
  121.   IF Divisor < 1 THEN RETURN
  122.   FOR j = 1 TO NumCount - Divisor
  123.     FOR k = j TO 1 STEP - Divisor
  124.       IF Number%(k + Divisor) > Number%(k) THEN GOTO EndLoop
  125.       SWAP Number%(k), Number%(k + Divisor)
  126.     NEXT k
  127.  
  128.   EndLoop:
  129.   NEXT j
  130.   GOTO DoShell
  131.  
  132. Metzner:
  133.   Divisor = NumCount
  134.  
  135. SetLoop:
  136.   Divisor = INT(Divisor/2)
  137.   IF Divisor < 1 THEN RETURN
  138.   Pointer2 = Number - Divisor
  139.   Pointer1 = 1
  140.  
  141.   SetExamine:
  142.     Examine = Pointer1
  143.  
  144.     DoMetzner:
  145.       Pass = Examine + Divisor
  146.       IF w(Examine) > w(Pass) THEN
  147.         SWAP Number%(Examine), Number%(Pass)
  148.         Examine = Examine - Divisor
  149.         IF Examine >= 0 THEN GOTO DoMetzner
  150.       END IF
  151.       Pointer1 = Pointer1 + 1
  152.       IF Pointer1 > Pointer2 THEN GOTO SetLoop
  153.       GOTO SetExamine
  154.  
  155. MakeHeader: 'substitite labels for line numbers
  156.   WHILE Number%(1) = 0  'kludge fix
  157.     FOR j = 2 TO NumCount
  158.       SWAP Number%(j-1), Number%(j)
  159.     NEXT
  160.     NumCount = NumCount - 1  
  161.   WEND
  162.   IF Hard = 1 THEN
  163.     FOR j = 1 TO NumCount
  164.       LPRINT "Jump"; j; " = "; Number%(j)
  165.     NEXT
  166.   END IF
  167.   FOR j = NumCount TO 1 STEP - 1
  168.   IF j/10 = INT(j/10) THEN PRINT j;
  169.     Label$ = STR$(j)
  170.     Label$ = "Jump" + RIGHT$(Label$,LEN(Label$)-1) + ":"
  171.     l$ = STR$(Number%(j))
  172.     l$ = RIGHT$(l$,LEN(l$)-1)
  173.     FOR k = count TO 1 STEP -1  'scan lines
  174.       IF LEFT$(Basic$(k),LEN(l$)) = l$ THEN
  175.         count = count + 2
  176.         FOR S = count TO k+2 STEP -1 'open a hole
  177.           SWAP Basic$(S), Basic$(S - 2)
  178.         NEXT
  179.         Basic$(k) = " "
  180.         Basic$(k + 1) = Label$ 
  181.       END IF
  182.     NEXT
  183.   NEXT
  184.   IF NumCount > 9 THEN PRINT 
  185.   RETURN
  186.  
  187. DeleteLN: 'delete line numbers
  188.   FOR j = 1 TO count
  189.     IF VAL(Basic$(j)) = 0 THEN GOTO skip
  190.     A = 50
  191.     WHILE A > 47 AND A < 58
  192.       A = ASC(Basic$(j))
  193.       Basic$(j) = RIGHT$(Basic$(j),LEN(Basic$(j)) - 1)
  194.     WEND
  195.     Basic$(j) = "  " + Basic$(j)
  196.     skip:
  197.   NEXT
  198.   RETURN
  199.  
  200.  
  201. Change: 'change numbers in lines to jump labels 
  202.   FirstTime = 1
  203.   FOR k = NumCount TO 1 STEP - 1
  204.     Label$ = STR$(k)
  205.     Label$ = "Jump" + RIGHT$(Label$,LEN(Label$)-1)
  206.     Test$ = STR$(Number%(k))
  207.     Test$ = LEFT$(Test$,LEN(Test$)-1)
  208.     FOR j = 1 TO count
  209.       Pointer = INSTR(Basic$(j),Test$)
  210.       IF Pointer <> 0 THEN
  211.         Test1 = INSTR(Basic$(j),"GO")  'protect harmless numbers  \
  212.         Test2 = INSTR(Basic$(j),"THEN") + Test1                    '|
  213.         Test2 = INSTR(Basic$(j),"RES") + Test2                     '|
  214.         IF Test2 > 0 AND Test2 < Pointer THEN                      '/
  215.           M$ = MID$(Basic$(j),Pointer, 1)
  216.           IF INSTR(", BO",M$) <> 0 THEN
  217.             First$ = LEFT$(Basic$(j),Pointer)
  218.             Last$ = RIGHT$(Basic$(j), LEN(Basic$(j)) - Pointer + 1)
  219.               A = 32
  220.               WHILE A = 32 OR (A > 47 AND A < 57) 'eat old jump number
  221.                 Last$ = RIGHT$(Last$,LEN(Last$) - 1)
  222.                 A = ASC(Last$ + CHR$(0))
  223.               WEND
  224.               Basic$(j) = First$ + Label$ + Last$
  225.           END IF
  226.         END IF
  227.       END IF 
  228.     NEXT
  229.   NEXT
  230.   RETURN
  231.  
  232. FindCol: 'look for :s in lines
  233.   FOR j = 1 TO count
  234.     V = INSTR(Basic$(j),":")
  235.     IF V > 0 THEN  ' check for blank place keeper lines
  236.       IF LEN(Basic$(j)) < 10 THEN
  237.         Basic$(j) = " "
  238.         V = 0
  239.       END IF
  240.     END IF
  241.     IF V > 0 THEN
  242.       V = INSTR(Basic$(j),"':")    'check for :s in REM statements
  243.       V1 = INSTR(Basic$(j),"REM")
  244.       V = V + V1
  245.       IF V = 0 OR V > 10 THEN
  246.         ColCount = ColCount + 1
  247.         Col%(ColCount) = j
  248.       END IF
  249.     END IF
  250.   NEXT
  251.   PRINT  "  Found"; ColCount; "lines..."
  252.   IF ColCount = 0 THEN RETURN
  253.   FOR jj = 1 TO ColCount
  254.     j = Col%(jj)
  255.     GOSUB EatCol
  256.   IF jj/10 = INT(jj/10) THEN PRINT  jj;
  257.   NEXT
  258.   IF jj > 9 THEN PRINT 
  259.   RETURN
  260.   
  261. EatCol: 'make multiple lines from :-type lines
  262.   Temp$(0) = Basic$(j)
  263.   TempCount = 1
  264.   FOR Cl = 1 TO 10  'clear holding array
  265.     Temp$(Cl) = ""
  266.   NEXT
  267.  
  268.   Eater:
  269.   M$ = "A"
  270.   WHILE M$ <> ":" AND Temp$(0) <> ""
  271.     M$ = LEFT$(Temp$(0),1)
  272.     Temp$(TempCount) = Temp$(TempCount) + M$
  273.     Temp$(0) = RIGHT$(Temp$(0),LEN(Temp$(0))-1)
  274.   WEND  
  275.   IF RIGHT$(Temp$(TempCount),1) = ":" THEN
  276.     Temp$(TempCount) = LEFT$(Temp$(TempCount),LEN(Temp$(TempCount))-1)
  277.   END IF
  278.   IF Temp$(0) <> "" THEN
  279.     TempCount = TempCount + 1
  280.     GOTO Eater
  281.   END IF
  282.  
  283.   IfCount = 0  'check for IF statements
  284.   FOR E = 1 TO TempCount
  285.     V = INSTR(Temp$(E),"IF")
  286.     IF V <> 0 THEN IfCount = IfCount + 1
  287.   NEXT
  288.   IF IfCount > 0 THEN
  289.     FOR E = 1 TO IfCount
  290.       TempCount = TempCount + 1
  291.       Temp$(TempCount) = "END IF"
  292.     NEXT
  293.   END IF
  294.   IF IfCount > 0 THEN 'split off THEN X statements
  295.     FOR E = 1 TO TempCount
  296.       V = INSTR(Temp$(E),"THEN")
  297.       IF V > 0 THEN
  298.         Hold$(1) = LEFT$(Temp$(E),V+3)
  299.         Hold$(2) = RIGHT$(Temp$(E),LEN(Temp$(E)) - V - 3)
  300.         TempCount = TempCount + 1  'expand array
  301.         FOR S = TempCount TO E + 1 STEP -1 'open a hole in it
  302.           SWAP Temp$(S), Temp$(S - 1)
  303.         NEXT
  304.         Temp$(E) = Hold$(1)
  305.         Temp$(E + 1) = Hold$(2)
  306.       END IF
  307.     NEXT
  308.   END IF
  309.  
  310.   FOR E = 1 TO TempCount   'eat leading spaces
  311.     IF LEFT$(Temp$(E),1) = " " THEN
  312.       Temp$(E) = RIGHT$(Temp$(E),LEN(Temp$(E))-1)
  313.     END IF
  314.   NEXT
  315.   FOR E = 1 TO TempCount  ' add padding spaces
  316.     IF VAL(Temp$(E)) = 0 THEN
  317.       Temp$(E) = "  " + Temp$(E)
  318.     END IF
  319.   NEXT
  320.   count = count + TempCount - 1 'expand array
  321.   FOR A = 1 TO ColCount 'update pointers
  322.     IF A > jj THEN Col%(A) = Col%(A) + TempCount - 1
  323.   NEXT
  324.   FOR S = count TO j + TempCount STEP -1 'open a hole in it
  325.     SWAP Basic$(S), Basic$(S - TempCount + 1)
  326.   NEXT
  327.   FOR E = 1 TO TempCount  'fill the hole
  328.     Basic$(j + E - 1) = Temp$(E)
  329.   NEXT
  330.   RETURN     
  331.  
  332.  
  333. Indent:  'pretty thing up
  334.   Add$ = ""
  335.   FOR j = 1 TO count            'indent loops
  336.     Basic$(j) = Add$ + Basic$(j)
  337.     F = INSTR(Basic$(j),"FOR")
  338.     N = INSTR(Basic$(j),"NEXT")
  339.     IF F > 0 AND N = 0 THEN GOSUB Push
  340.     IF F = 0 AND N > 0 THEN GOSUB Pull
  341.     T = INSTR(Basic$(j),"THEN")
  342.     E = INSTR(Basic$(j),"END IF")
  343.     IF T > 0 AND (LEN(Basic$(j)) - T < 7) THEN GOSUB Push
  344.     IF E > 0 THEN GOSUB Pull
  345.   NEXT
  346.   RETURN
  347.  
  348. Push: 'indent by two spaces
  349.   Add$ = Add$ + "  "
  350.   RETURN  
  351.  
  352. Pull: 'deindent by two spaces
  353.   IF LEN(Add$) > 2 THEN Add$ = LEFT$(Add$,LEN(Add$) - 2)
  354.   Basic$(j) = RIGHT$(Basic$(j),LEN(Basic$(j)) - 2)
  355.   RETURN
  356.  
  357.  
  358. Savit: 'save file to disk
  359. OPEN Newfile$ FOR OUTPUT AS #1
  360.   FOR j = 1 TO count
  361.     PRINT #1, Basic$(j)
  362.   NEXT
  363.   CLOSE 1
  364.   RETURN
  365.   
  366. ErrorCheck:  'look for simple errors
  367.   EndFlag = 0
  368.   FOR j = 1 TO count
  369.     V = INSTR(Basic$(j),"IF")
  370.     V1 = INSTR(Basic$(j),"THEN")
  371.     IF (V = 0 AND V1 > 1) OR (V1 = 0 AND V > 0) THEN
  372.       BEEP
  373.       PRINT 
  374.       PRINT  "IF ... THEN Error in line"; VAL(Basic$(j))
  375.       PRINT  Basic$(j)
  376.       EndFlag = 1
  377.     END IF
  378.   NEXT
  379.   IF EndFlag = 1 THEN END
  380.   RETURN 
  381.  
  382. Hello: 'intro text
  383. LOCATE 2,1
  384. PRINT  SPACE$(33)"CONVERT BASIC"
  385. PRINT 
  386. PRINT  " This is a shareware program copyright 1987 to George Trepal.  It's OK to"
  387. PRINT  " give it to friends but wrong to sell it.  If you find it useful please"
  388. PRINT  " send a contribution to George Trepal, 2650 Alturas Rd.,  Bartow, Florida"
  389. PRINT  " 33830& USA.  (Thank you!)"
  390. PRINT  
  391. PRINT  "    This program helps to convert Basic programs from other computers to"
  392. PRINT  " AmigaBasic."
  393. PRINT  "    This program removes line numbers and inserts jump labels into Basic"
  394. PRINT  " programs.  It can only use ASCII files with command words in uppercase"
  395. PRINT  " letters.  Load the program into AmigaBASIC to capitalize the command words"
  396. PRINT  " then save it by SAVE ''filename'',a to generate an ASCII file."
  397. PRINT 
  398. PRINT 
  399. PRINT  "   Be sure to include a path (df0:filename rather than just filename)"
  400. RETURN
  401.  
  402.  
  403.  
  404.             
  405.