home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PRO98SRC.ZIP / PREP.BAS < prev    next >
BASIC Source File  |  1994-02-01  |  11KB  |  287 lines
  1. SUB PRXLOADARRAY(Fi$,P$())
  2.         MaxLine%=0
  3.         FF=FREEFILE
  4.     OPEN Fi$ FOR INPUT AS #FF
  5.         LINE INPUT #ff, P$(0) ' version
  6.         input #ff, N% ' number of variables
  7.         FOR y=1 to N%
  8.             INPUT #ff, A$,B$
  9.                 REPLACE CHR$(254) WITH " " IN B$
  10.                 VSET2 A$,B$
  11.         NEXT y
  12.         DO until eof(ff)
  13.             incr MaxLine%
  14.                 line input #FF, p$(MaxLine%)
  15.         loop
  16.         close #ff
  17. END SUB
  18.  
  19. SUB PRXSAVEARRAY(Fi$,P$())
  20.     ' All variables defined at this point are incorporated into the
  21.         ' compiled program.  This can be very dangerous if done at the
  22.         ' wrong time (like when lots of variables are in memory)
  23.         Fi$=UCASE$(Fi$)
  24.         IF INSTR(Fi$,".LIB") or INSTR(Fi$,".SUB") or INSTR(Fi$,".PLB") THEN Subbing=%True
  25.         ' Setting Subbing to %True causes string constants to be set with
  26.         ' a higher ascii value, so they won't be overwritten by ordinary
  27.         ' pre-processing of string constants.  Only one procedure file
  28.         ' is allowed at a time.
  29.  
  30.         PROZOPRINT "["+Fi$+"]"
  31.         PREPARRAY P$()
  32.     FF=FREEFILE
  33.         OPEN Fi$ FOR OUTPUT AS #FF
  34.         PRINT #FF, P$(0) ' version
  35.         PRINT #FF, NextVar% ' number of variables defined
  36.         FOR i = 1 to NextVar%
  37.                 V$=VALUE$(i)
  38.                 'REPLACE " " WITH CHR$(254) IN V$
  39.             Write #FF,VAR$(i),V$
  40.     NEXT i
  41.         ' program starts here
  42.         i=0
  43.         DO
  44.             INCR i
  45.             IF P$(i)="" THEN EXIT LOOP
  46.             PRINT #FF, P$(i)
  47.     LOOP
  48.         CLOSE #FF
  49. END SUB
  50.  
  51. SUB PREPARRAY (P$())
  52.     ' This routine preps an entire array and leaves variables in
  53.         ' memory (which can be extracted for prep-save format)
  54.         Prepping% = %True
  55.     VarTableX%=176:VarTableZ%=176
  56.         dim temp$(ubound(p$))  ' storage for compiled array
  57.     dim l$(256):dim l(256) ' storage for labels and line numbers
  58. ' PASS 1
  59.         for y=1 to ubound(p$)  ' preprocess each line
  60.             p$=p$(y)
  61.                 prep p$
  62.                 if len(p$) then
  63.                         incr x
  64.                            if right$(p$,4)="PROC" then
  65.                                 decr x
  66.                                 p$=left$(p$,len(p$)-5) 'take off the "proc"
  67.                                 if instr(p$," ") then ' there's something to it
  68.                                    rinstr p$," ",s
  69.                                    v$=mid$(p$,s+1)
  70.                                    p$=left$(p$,s-1)
  71.                                    vset2 v$,p$
  72.                                 end if
  73.                                iterate for
  74.                            end if
  75.  
  76.                         if left$(p$,1)<>chr$(2) then
  77.                            ' it's a label or procedure
  78.                            incr l
  79.                              if instr(p$," ") then
  80.                                 l$(l)=left$(p$,instr(p$," ")-1)
  81.                                 p$=mid$(p$,instr(p$," ")+1)
  82.                                 l(l)=x
  83.                                 temp$(x)=ltrim$(rtrim$(p$))
  84.                              else
  85.                                l$(l)=p$
  86.                                    l(l)=x
  87.                                    decr x
  88.                              end if
  89.                         else
  90.                             reprint str$(x)
  91.                             temp$(x)=p$
  92.                         end if
  93.         end if
  94.     next y
  95. ' now replace all label references with a literal line number
  96.  
  97. ' PASS 2
  98.     for y=1 to ubound(p$)
  99.             if len(temp$(y)) then
  100.                 for x=1 to l
  101.                     replace l$(x) with ltrim$(str$(l(x))) in temp$(y)
  102.                 next x
  103.         end if
  104.             p$(y)=temp$(y)
  105.         next y
  106.     Prepping%=%False:Subbing=%False
  107.         p$(0)=PrxVer$
  108. END SUB
  109.  
  110. SUB PREP (Prg$)
  111. IF LEFT$(Prg$,1)=CHR$(2) THEN EXIT SUB 'already prepped
  112. ' Remove all REMARKS
  113. if instr(prg$,any "/*'" + chr$(34)) then
  114. DO
  115. a%=INSTR(PRG$,"/*")
  116. IF a% THEN
  117.         VALUE$=MID$(PRG$, a%)
  118.         b%=INSTR(2,VALUE$, "*/")
  119.         IF b% THEN VALUE$=LEFT$(VALUE$,b%+1)
  120.         PRG$=REMOVE$(PRG$,VALUE$)
  121. END IF
  122. LOOP WHILE a%
  123.  
  124. ' Remove all quoted strings and make temporary variables out of them.
  125. if not Prepping% then VarTableX%=176:VarTableZ%=176
  126. if subbing then VarTableZ%=219
  127. DO
  128. a%=INSTR(PRG$,CHR$(34))
  129. IF a% THEN
  130.         VALUE$=MID$(PRG$, a%)
  131.         b%=INSTR(2,VALUE$, CHR$(34))
  132.         IF b% THEN VALUE$=LEFT$(VALUE$,b%)
  133.         REPLACE VALUE$ WITH " "+CHR$(1,VarTableZ%,VarTableX%)+" " IN PRG$
  134.         ARRAY SCAN VAR$(1), COLLATE UCASE, =CHR$(1,VarTableZ%,VarTableX%), TO i%
  135.         IF i% THEN
  136.             VALUE$(i%)=REMOVE$(VALUE$,CHR$(34))
  137.     ELSE
  138.             INCR NextVar%
  139.                 VALUE$(NextVar%)=REMOVE$(VALUE$,CHR$(34))
  140.                 VAR$(NextVar%)=CHR$(1,VarTableZ%,VarTableX%)
  141.         END IF
  142. ELSE
  143.     EXIT LOOP
  144. END IF
  145. INCR VarTableX%:IF VarTableX%=254 THEN VarTableX%=176:INCR VarTableZ%
  146. LOOP
  147.  
  148. ' Remove any strings quoted with ' character that are not inside ""
  149.  
  150. DO
  151. a%=INSTR(PRG$,CHR$(39))
  152. IF a% THEN
  153.         VALUE$=MID$(PRG$, a%)
  154.         b%=INSTR(2,VALUE$,CHR$(39))
  155.         IF b% THEN VALUE$=LEFT$(VALUE$,b%)
  156.         REPLACE VALUE$ WITH " "+CHR$(1,VarTableZ%,VarTableX%)+" " IN PRG$
  157.         ARRAY SCAN VAR$(1), COLLATE UCASE, =CHR$(1,VarTableZ%,VarTableX%), TO i%
  158.         IF i% THEN
  159.             VALUE$(i%)=REMOVE$(VALUE$,CHR$(39))
  160.     ELSE
  161.             INCR NextVar%
  162.                 VALUE$(NextVar%)=REMOVE$(VALUE$,CHR$(39))
  163.                 VAR$(NextVar%)=CHR$(1,VarTableZ%,VarTableX%)
  164.         END IF
  165. ELSE
  166.     EXIT LOOP
  167. END IF
  168. INCR VarTableX%:IF VarTableX%=254 THEN VarTableX%=176:INCR VarTableZ%
  169. LOOP
  170. end if ' if quote or rem chars are in prg$
  171.  
  172.  
  173. ' Secondly, we have to deal with the harsh realities of NUMERIC EXPRESSIONS.
  174. ' We could certainly work that into EXEC as well, using a technique called
  175. ' RECURSIVE DESCENT PARSING, but that, too would start making things a bit
  176. ' hideous.
  177. ' Being able to handle an line like ...
  178. '                      PRINT B*20/C+(INT(D/100))
  179. ' ... where a statement is followed by an expression which includes
  180. ' literal numbers and variables and functions (like INT) would require a
  181. ' much more complex parsing algorithm than we are introducing here.
  182. ' Another way to deal with expressions is to force any arithmetic to
  183. ' be performed in special arithmetic functions, like ...
  184. '
  185. '    PRINT ADD(DIV(MUL(B,20),C),INT(DIV(D,100))
  186. '
  187. ' with the stack-parsing technique we are using for language processing
  188. ' this type of expression would be much much much easier to implement, BUT
  189. ' it starts to make our language seem pretty silly, so what we are going to
  190. ' do is this:  By pushing arithmetic symbols onto the argument stack along
  191. ' with the rest of the arguments, a variable-free, statement-free expression
  192. ' can be built whenever the stack is popped clean by the CALC function.
  193. ' in other words, the above expression would wind up looking like this:
  194. '
  195. '     PRINT CALC B*20/C+(INT(CALC D/100))
  196. '
  197. ' ... which I would consider more of a fair compromise, and for the burden
  198. ' of forcing you to use the CALC command before every arithmetic expression
  199. ' you can still use natural arithmetic without having to make your language
  200. ' look like FrameWork Fred. (ick!)  To accomplish this, we have to make
  201. ' sure that arithmetic symbols get parsed and pushed as individuals.  In
  202. ' order for that to happen, we must ensure that they are separated by a
  203. ' parsing character, such as a SPACE.
  204.  
  205. if instr(prg$,any "+-*/<>()=&_?") then
  206. REPLACE "+" WITH " + " IN PRG$
  207. REPLACE "-" WITH " - " IN PRG$
  208. REPLACE "*" WITH " * " IN PRG$
  209. 'REPLACE "\" WITH " \ " IN PRG$
  210. REPLACE "/" WITH " / " IN PRG$
  211. 'REPLACE "^" WITH " ^ " IN PRG$
  212. REPLACE "<" WITH " < " IN PRG$
  213. REPLACE ">" WITH " > " IN PRG$
  214. REPLACE "(" WITH " ( " IN PRG$
  215. REPLACE ")" WITH " ) " IN PRG$
  216. REPLACE "=" WITH " = " IN PRG$
  217. REPLACE "&" WITH " & " IN PRG$
  218. REPLACE "?" WITH "" IN PRG$
  219. REPLACE "_"+CHR$(13,10) WITH " " IN PRG$
  220. end if
  221.  
  222. ' Now, finally, we will be dealing in a free-form program structure where
  223. ' the single string being processed here may contain carriage returns and
  224. ' line feeds.  In the case of multiple lines, we don't want the whole
  225. ' module executed in REV (which is what stack-parsing does) so we will
  226. ' remove all carriage returns and line feeds, and we'll be flipping the
  227. ' lines, so the last lines come first and the first come last.  To fully
  228. ' understand why we are doing this, you must fully understand stack-parsing.
  229. ' In stack parsing, we push every item in a single statement onto a stack,
  230. ' processing it as it goes, from last to first.  If you have a line which
  231. ' read like this:
  232. '
  233. '               print      mid$      (A$,     Y%,      1)
  234. '               ^^^^^      ^^^^      ^^^^     ^^^      ^^
  235. '        STATEMENT  FUNCTION  VARIABLE VARIABLE ARGUMENT
  236. ' ... the stack-parser start out by pushing the argument 1 as a literal
  237. ' number.  Then it would evaluate Y% and push it's value as a literal
  238. ' number.  Then it would evaluate A$ and push it's contents as a literal
  239. ' string.  Then it would get to the function MID$.  It would POP the three
  240. ' arguments in order to see what it needs to MID$ with, and then push the
  241. ' result as a literal string.  Finally, PRINT would see that one single
  242. ' item on the stack (the result of MID$) and print it.  For more information
  243. ' about stack parsing, go back 20 lines and read this again until you get it.
  244.  
  245. IF INSTR(PRG$,ANY CHR$(13,58,123,125)) THEN
  246.         ' remove all line feeds (PBWrite and other text editors produce them)
  247.         ' Add a closing carriage return, just in case, and then REV
  248.         ' the order of every line of text.
  249.     PRG$=REV$(REMOVE$(PRG$,ANY CHR$(10)+"{}"))
  250.         ' and remove blank lines
  251. END IF
  252.  
  253. REPLACE ANY ",;" WITH "  " IN PRG$ ' make all parsers into spaces
  254. REPLACE "_ " with " " in prg$
  255. DO
  256. REPLACE "  " WITH " " IN PRG$   ' elimate double spaces
  257. LOOP UNTIL INSTR(PRG$,"  ")=0
  258.  
  259. PRG$=" " + UCASE$(PRG$)+" "
  260. ' replace all keywords with tokens
  261. x=1
  262. DO UNTIL Fixup(x).offset=0 or instr(prg$,any "BCDFGHKLMNPRSTVWX")=0
  263. fk$=rtrim$(fixup(x).keyword)+" "
  264. if instr(prg$,fk$) then
  265.     n$=chr$(32,2)+ltrim$(str$(x))+" "
  266.     replace fk$ with n$ in Prg$
  267.     if instr(Prg$,fk$) then replace fk$ with n$ in Prg$
  268. ' We had to do that a second time incase of two back to back same keywords
  269. end if
  270. incr x
  271. LOOP
  272. PRG$=LTRIM$(RTRIM$(PRG$))
  273. END SUB
  274.  
  275. FUNCTION REV$(byval X$)
  276. IF X$="" THEN EXIT FUNCTION
  277. IF INSTR(X$,ANY CHR$(13,58)) = 0 THEN
  278.     REV$=X$
  279.         EXIT FUNCTION
  280. ELSE
  281.     Y$=LEFT$(X$,INSTR(X$,ANY CHR$(13,58))-1)
  282.         Z$=MID$(X$,INSTR(X$,ANY CHR$(13,58))+1)
  283.         REV$=REV$(Z$)+" " + Y$
  284. END IF
  285.  
  286. END FUNCTION
  287.