home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / preprss.lbr / BSLP.PZ / BSLP.P
Encoding:
Text File  |  1993-10-25  |  22.9 KB  |  822 lines
  1. BSLP.P
  2.  
  3. '------------------------------------------------------
  4. '-(c) Bendorf Associates, 1984-85                     -
  5. '------------------------------------------------------
  6. '- Program:BSLP (BASIC STRUCTURED LANGUAGE PREPROCESSOR)
  7. '- System :PPE
  8. '- Module :TOOLS
  9. '- Task   :COMPILE 'SSS' CODE INTO STANDARD BASIC CODE.
  10. '- Created:10.1.82
  11. '- By     :D. L. BENDORF
  12. '- Version:PUBLIC DOMAIN
  13. '- Notes  :THIS PROGRAM IS NOT FOR RESALE.
  14. '- History:
  15. '-   BSLP  translates  source  text  written in 'SSS' structure language to
  16. '-   standard BASIC code. BSLP is a  BASIC  language  version  of  the  PPE
  17. '-   structure  translater. It is slow but very usable, and has served well
  18. '-   as a tool for prototype extensions to the structure language. BSLP  is
  19. '-   written  in  BSLP  structure  language and should be a useful learning
  20. '-   tool.
  21. '- Invocation:
  22. '-   Entering 'BSLP' at the DOS prompt will  envoke  the  compiled  version
  23. '-   (.EXE)  of  BSLP.  The  (.BAS)  version  will have to be run using the
  24. '-   interpreter by entering 'BASICA BSLP' at the  DOS  prompt.  BSLP  will
  25. '-   then  prompt  for  the  input  file name and the output file name. The
  26. '-   default for the input file extension is '.P', and the default for  the
  27. '-   output  file  is  'input-file.BAS'.  The slash (/) following the input
  28. '-   file name will cause all non-referenced line  numbers  to  be  deleted
  29. '-   from  the  output  file  (.BAS). This allows a smaller compiled (.EXE)
  30. '-   program.
  31. '- Hints and Restrictions:
  32. '-   'SSS'  keywords  are  not  case or position sensitive, and  they  must
  33. '-   (except  for spaces and tabs) be the first words on a line. Do NOT use
  34. '-   comments on the same line with keywords. The vertical bar (|)  may  be
  35. '-   use  to  provide  line continuation. Continued lines will be appended,
  36. '-   separating them with a colon (:).
  37. '- 'SSS' Keywords:
  38. '-   PROG / PEND
  39. '-   PROC <label> / ENDP
  40. '-   REPEAT / UNTIL <condition>
  41. '-   LOOP [<when/unless> <condition>] / ENDL [<when/unless> <condition>]
  42. '-   WHEN <condition> / ELSE [<when/unless> <condition>] / ENDW
  43. '-   UNLESS <condition> / ENDU
  44. '-   SWITCH <left operand> / CASE <right operand> / BREAK / ENDC
  45. '------------------------------------------------------
  46. '- ** Data Division                                   -
  47. '------------------------------------------------------
  48. DATA   proc...
  49. DATA   prog...
  50. DATA   when...
  51. DATA   unless.
  52. DATA   repeat.
  53. DATA   loop...
  54. DATA   switch.
  55. DATA   case...
  56. DATA   else...
  57. DATA   break..
  58. DATA   endp...
  59. DATA   pend...
  60. DATA   endw...
  61. DATA   endu...
  62. DATA   until..
  63. DATA   endl...
  64. DATA   endc...
  65. PROC.%   = 1
  66. PROG.%   = 2
  67. WHEN.%   = 3
  68. UNLESS.% = 4
  69. REPEAT.% = 5
  70. LOOP.%   = 6
  71. SWITCH.% = 7
  72. CASE.%   = 8
  73. ELSE.%   = 9
  74. BREAK.%  = 10
  75. ENDP.%   = 11
  76. PEND.%   = 12
  77. ENDW.%   = 13
  78. ENDU.%   = 14
  79. UNTIL.%  = 15
  80. ENDL.%   = 16
  81. ENDC.%   = 17
  82. DATA 11,12,13,14,15,16,17,17,13,17
  83. DOT$     = "."
  84. DOTS$    = "...."
  85. SKIP$    = " "
  86. SKIP1$   = "  '"
  87. OEXT$    = ".BAS"
  88. IEXT$    = ".P"
  89. EEXT$    = ".E"
  90. INCL$    = ".INC"
  91. TM$      = " ,="
  92. T.FILE$  = "BSLP.$$$"
  93. T.FILE%  = 1
  94. E.FILE%  = 2
  95. I.FILE%  = 3
  96. O.FILE%  = 3
  97. ERRORS%  = 0
  98. KERR%    = 1
  99. LEVELS%  = 0
  100. PUSH%    = 0
  101. NUM%     = 0
  102. STACK.%  = 0
  103. NKEY%    = 17
  104. INCS%    = 1
  105. INC%     = 0
  106. FILE%    = 2
  107. BASIC$   = "restore.resume.return.goto.gosub"
  108. DIM CLOSING%(10)        ' For error messages.
  109. DIM INC$(50)            ' Include file stack.
  110. DIM STACK$(500)
  111. DIM STACK%(500)
  112. DIM NUM.%(500)
  113. DIM KEYWORD.%(99,2)
  114. DIM XN.%(99)
  115. DIM LOOPS%(99)
  116. DIM SWITCH$(10)         ' For the left operand of SWITCH.
  117. DIM KEYWORD$(22)        ' For error messages.
  118. FOR I%=1 TO NKEY%|
  119.     READ BUF$|
  120.     TABLE$=TABLE$+BUF$|
  121.     KEYWORD$(I%)=BUF$|
  122. NEXT I%
  123. FOR I%=1 TO 10|
  124.     READ CLOSING%(I%)|
  125. NEXT I%
  126. '------------------------------------------------------
  127. '- ** Procedure Division                              -
  128. '------------------------------------------------------
  129. prog BSLP
  130.     PRINT "BSLP   V1.1B (C) BENDORF ASSOCIATES, 1984-85"
  131.     PRINT|
  132.     GoSub FILENAMES
  133.     when GOOD%
  134.         GoSub BEGIN
  135.     else when I.FILE$<>""
  136.         PRINT"CANNOT OPEN ";I.FILE$
  137.     endw
  138. pend
  139. proc BEGIN
  140.     GoSub PASS_1
  141.     '
  142.     ' Kill the error file if no errors in PASS_1.
  143.     ' Kill the temp file after PASS_2.
  144.     ' Kill the output file if errors in PASS_2.
  145.     '
  146.     CLOSE
  147.     when ERRORS%=0
  148.         KILL E.FILE$|
  149.         GoSub PASS_2|
  150.         CLOSE|
  151.         KILL T.FILE$
  152.     else
  153.         KILL T.FILE$|
  154.         PRINT E.FILE$;" PRODUCED WITH ";STR$(ERRORS%);" ERROR(S)."
  155.         END
  156.     endw
  157.     when ERRORS%>0
  158.         KILL O.FILE$|
  159.         PRINT O.FILE$;" ABORTED WITH ";STR$(ERRORS%);" ERROR(S)."
  160.     else
  161.         PRINT"<";O.FILE$;"> DONE!"
  162.     endw
  163. endp
  164. proc PASS_1
  165.     '
  166.     ' This is the first phase of processing.
  167.     ' All included file will be processed here.
  168.     ' The error file is written during this pass.
  169.     '
  170.     Open"O",T.FILE%,T.FILE$|
  171.     Open"O",E.FILE%,E.FILE$|
  172.     GoSub PUSH|
  173.     INC$(INCS%)=I.FILE$
  174.     loop
  175.         INC%=INC%+1|
  176.         FILE%=FILE%+1|
  177.         FILE$=INC$(INC%)|
  178.         Open"I",FILE%,FILE$
  179.         loop
  180.             GoSub INPUT-SOURCE|
  181.             GoSub POP_ERRORS
  182.         until FILE%=2
  183.     until INC%=INCS%
  184. endp
  185. proc INPUT-SOURCE
  186.     '
  187.     ' Read the input file and look for SLP keywords.
  188.     ' Look for include file operators(+-).
  189.     ' Write error file just in case there is a PASS_1 error.
  190.     '
  191.     loop
  192.         LINE INPUT #FILE%,BUF$
  193.         when LEN(BUF$)>2
  194.             XLINE$=BUF$:GoSub STRIP
  195.             unless LEN(BUF$)=0
  196.                 INDEX%=0:GoSub PARSER
  197.                 when RIGHT$(TEXT$,1)=":"
  198.                     IF(LEN(SBUFF$)>0)THEN GoSub DUMP
  199.                     FLAG%=2:LEVEL$=LEFT$(TEXT$,LEN(TEXT$)-1)|
  200.                     COMMENT$=SKIP1$+LEVEL$|
  201.                     GoSub OUT_LINE
  202.                 else
  203.                     L$=LEFT$(TEXT$,1):KEYWORD%=0
  204.                     unless LEN(TEXT$)<4 OR LEN(TEXT$)>6
  205.                         C.$=TEXT$:GoSub _Fold|
  206.                         KEYS$=C.$+DOTS$|
  207.                         KEYWORD%=INSTR(1,TABLE$,LEFT$(KEYS$,7))|
  208.                         KEYWORD%=(KEYWORD%+6)\7
  209.                     endu
  210.                     when KEYWORD%>0
  211.                         IF(LEN(SBUFF$)>0)THEN GoSub DUMP
  212.                         GoSub KEYWORDS
  213.                     else when L$="-"
  214.                         GoSub SUBROUTINE
  215.                     else when L$="+"
  216.                         IF(LEN(SBUFF$)>0)THEN GoSub DUMP
  217.                         GoSub INCLUDES
  218.                     else 
  219.                         GoSub OUT_PUT
  220.                     endw
  221.                 endw
  222.             endu
  223.             NERR%=NERR%+1|
  224.             PRINT #E.FILE%,STR$(NERR%);SKIP$;XLINE$
  225.         endw
  226.     until EOF(FILE%)
  227.     CLOSE #FILE%|
  228.     FILE%=FILE%-1
  229.     unless SBUFF$=""
  230.         BUF$="":CFLAG%=0:GoSub OUT_PUT
  231.     endu
  232. endp
  233. proc STRIP
  234.     '
  235.     ' Strip the leading and trailing spaces,tabs and linefeeds off of
  236.     ' the input buffer.
  237.     ' Look for the continuation operator.
  238.     '
  239.     Z1%=INSTR(BUF$,CHR$(9)):Z2%=INSTR(BUF$,CHR$(10))
  240.     WHILE (Z1% OR Z2%)
  241.         IF Z1% THEN MID$(BUF$,Z1%,1)=" "
  242.         IF Z2% THEN MID$(BUF$,Z2%,1)=" "
  243.         Z1%=INSTR(BUF$,CHR$(9)):Z2%=INSTR(BUF$,CHR$(10))|
  244.     WEND
  245.     Z1%=1|
  246.     WHILE (MID$(BUF$,Z1%,1)=" " AND Z1%<LEN(BUF$))|
  247.         Z1%=Z1%+1|
  248.     WEND
  249.     Z2%=LEN(BUF$)|
  250.     WHILE (MID$(BUF$,Z2%,1)=" " AND Z2%>1)|
  251.         Z2%=Z2%-1|
  252.     WEND
  253.     when Z2%<Z1%
  254.         BUF$=""
  255.     else
  256.         BUF$=MID$(BUF$,Z1%,Z2%-Z1%+1)
  257.         when LEN(BUF$)>0
  258.             IF(LEFT$(BUF$,1)="'" OR LEFT$(BUF$,3)="REM" OR BUF$=STRING$(LEN(BUF$),32))THEN BUF$=""
  259.         endw
  260.     endw
  261.     LN.%=LEN(BUF$):CFLAG%=0
  262.     unless LN.%=0
  263.         CFLAG%=(RIGHT$(BUF$,1)="|")
  264.         IF(CFLAG%)THEN BUF$=LEFT$(BUF$,LN.%-1):LN.%=LEN(BUF$)
  265.     endu
  266. endp
  267. proc OUT_PUT
  268.     '
  269.     ' Process lines not beginning with keywords.
  270.     ' If CFLAG% flag is set, append input lines together
  271.     ' and always check the total length first.
  272.     '
  273.     when CFLAG%=0 
  274.         when LEN(SBUFF$)>0
  275.             when LEN(SBUFF$+BUF$)<=250
  276.                 BUF$=SBUFF$+BUF$:SBUFF$=""
  277.             else
  278.                 GoSub DUMP
  279.             endw
  280.         endw
  281.         PBUF$=BUF$:FLAG%=3:GoSub OUT_LINE
  282.     else when LEN(SBUFF$+BUF$)<=250
  283.         SBUFF$=SBUFF$+BUF$+":"
  284.     else
  285.         GoSub DUMP:PBUF$=BUF$:GoSub OUT_LINE
  286.     endw
  287.     BUF$=""
  288. endp
  289. proc DUMP
  290.     PBUF$=LEFT$(SBUFF$,LEN(SBUFF$)-1)|
  291.     FLAG%=3:GoSub OUT_LINE:SBUFF$="":CFLAG%=0
  292. endp
  293. proc KEYWORDS
  294.     '
  295.     ' Branch to the right keyword processing.
  296.     ' This is one of the few acceptable uses of the `GOTO'.
  297.     '
  298.     KERR%=NERR%+1
  299.     ON KEYWORD% GOTO _PROC,_PROG,_WHEN,_UNLESS,_REPEAT,_REPEAT
  300.     ON KEYWORD%-6 GOTO _SWITCH,_CASE,_ELSE,_BREAK,_ENDP,_PEND,_ENDW
  301.     ON KEYWORD%-13 GOTO _ENDU,_UNTIL,_ENDL,_ENDC
  302. endp
  303. proc POP_ERRORS
  304.     '
  305.     ' Resolve all un-closed processes and report errors.
  306.     '
  307.     KER%=KERR%:KWDS%=KEYWORD%:GoSub POP
  308.     while KEYWORD%>0
  309.         GoSub RESOLVE-ERRORS
  310.     wend
  311.     GoSub PUSH:KEYWORD%=KWDS%:KERR%=KER%
  312. endp
  313. proc RESOLVE-ERRORS
  314.     IF(KEYWORD%<11)THEN KEYWORD%=CLOSING%(KEYWORD%)
  315.     EBUF$=KEYWORD$(KEYWORD%):GoSub ERRORS
  316.     when KEYWORD%=ENDW.% OR KEYWORD%=ENDU.% OR KEYWORD%=ENDC.%
  317.         IF(KEYWORD%=ENDC.%)THEN GoSub POP
  318.         GoSub POP
  319.     endw
  320.     GoSub POP
  321. endp
  322. proc PUSH
  323.     PUSH%=PUSH%+1|
  324.     KEYWORD.%(PUSH%,0)=KEYWORD%|
  325.     KEYWORD.%(PUSH%,1)=KERR%|
  326.     KEYWORD.%(PUSH%,2)=LEVEL%
  327. endp
  328. proc POP
  329.     when PUSH%>0
  330.         KEYWORD%=KEYWORD.%(PUSH%,0)|
  331.         KERR%=KEYWORD.%(PUSH%,1)|
  332.         LEVEL%=KEYWORD.%(PUSH%,2)|        
  333.         PUSH%=PUSH%-1
  334.     else
  335.         LEVEL%=-1|
  336.         KEYWORD%=-1
  337.     endw
  338. endp
  339. proc LEVEL
  340.     LEVELS%=LEVELS%+1:LEVEL%=LEVELS%|
  341.     TK%=LEVEL%:GoSub PUSH
  342. endp
  343. proc _PROC
  344.     GoSub POP_ERRORS|
  345.     GoSub PUSH|
  346.     GoSub PARSER
  347.     when LEN(TEXT$)>0
  348.         COMMENT$=SKIP1$+TEXT$:LPROC$=TEXT$|
  349.         FLAG%=2:LEVEL$=TEXT$:GoSub OUT_LINE
  350.     else
  351.         EBUF$="procedure name":GoSub ERRORS
  352.     endw
  353. endp
  354. proc _ENDP
  355.     GoSub POP
  356.     WHILE KEYWORD%<>PROC.% AND KEYWORD%>0
  357.         GoSub RESOLVE-ERRORS
  358.     WEND        
  359.     when KEYWORD%=PROC.%
  360.         FLAG%=3:PBUF$="RETURN":GoSub OUT_LINE
  361.     else
  362.         EBUF$=KEYWORD$(PROC.%):GoSub ERRORS
  363.     endw
  364. endp
  365. proc _PROG
  366.     PROG..%=1
  367. endp
  368. proc _PEND
  369.     when PROG..%=1
  370.         FLAG%=3:PBUF$="END":GoSub OUT_LINE
  371.     else
  372.         EBUF$=KEYWORD$(PROG.%):GoSub ERRORS
  373.     endw
  374. endp
  375. proc _WHEN
  376.     GoSub LEVEL:GoSub LEVEL|
  377.     FLAG%=1:GoSub OUT_LINE
  378. endp
  379. proc _ELSE
  380.     GoSub POP
  381.     when KEYWORD%=WHEN.%
  382.         F.%=LEVEL%:GoSub POP:T.%=LEVEL%:TK%=T.%|
  383.         FLAG%=4:PBUF$="GOTO ":GoSub OUT_LINE|
  384.         XN%=XN%+1:XN.%(XN%)=F.%|
  385.         GoSub PARSER:C.$=TEXT$:GoSub _Fold
  386.         when C.$="when" OR C.$="unless"
  387.             GoSub LEVEL:F.%=LEVEL%|
  388.             FLAG%=ABS(C.$="when"):GoSub OUT_LINE:GoSub POP
  389.         else
  390.             F.%=0
  391.         endw
  392.         KEYWORD%=WHEN.%|
  393.         LEVEL%=T.%:GoSub PUSH|
  394.         LEVEL%=F.%:GoSub PUSH
  395.     else
  396.         GoSub PUSH|
  397.         EBUF$=KEYWORD$(WHEN.%):GoSub ERRORS
  398.     endw
  399. endp
  400. proc _ENDW
  401.     GoSub POP
  402.     when KEYWORD%=WHEN.%
  403.         F.%=LEVEL%:GoSub POP:T.%=LEVEL%:GoSub POPOFF
  404.     else
  405.         GoSub PUSH|
  406.         EBUF$=KEYWORD$(WHEN.%):GoSub ERRORS
  407.     endw
  408. endp
  409. proc POPOFF
  410.     IF(F.%>0)THEN XN%=XN%+1:XN.%(XN%)=F.%
  411.     IF(T.%>0)THEN XN%=XN%+1:XN.%(XN%)=T.%
  412. endp
  413. proc _UNLESS
  414.     GoSub LEVEL:GoSub LEVEL|
  415.     FLAG%=0:GoSub OUT_LINE
  416. endp
  417. proc _ENDU
  418.     GoSub POP
  419.     when KEYWORD%=UNLESS.%
  420.         F.%=LEVEL%:GoSub POP:T.%=LEVEL%:GoSub POPOFF
  421.     else
  422.         GoSub PUSH|
  423.         EBUF$=KEYWORD$(UNLESS.%):GoSub ERRORS
  424.     endw
  425. endp
  426. proc _REPEAT
  427.     GoSub PARSER:C.$=TEXT$:GoSub _Fold|
  428.     LOOP%=LOOP%+1:GoSub LEVEL|
  429.     XN%=XN%+1:XN.%(XN%)=LEVEL%
  430.     when C.$<>"when" AND C.$<>"unless"
  431.         LOOPS%(LOOP%)=LEVEL%|
  432.     else
  433.         LOOPS%(LOOP%)=LEVEL%*-1|
  434.         GoSub POP:LEVEL%=LEVEL%*-1:GoSub PUSH|
  435.         GoSub LEVEL|
  436.         FLAG%=ABS(C.$="when")|
  437.         GoSub OUT_LINE
  438.     endw
  439. endp
  440. proc _UNTIL
  441.     when LOOP%>0
  442.         GoSub POP
  443.         when KEYWORD%=REPEAT.% OR KEYWORD%=LOOP.%
  444.             LOOP%=LOOP%-1:TK%=LOOPS%(LOOP%+1)|
  445.             FLAG%=1:GoSub OUT_LINE
  446.         else
  447.             GoSub PUSH|
  448.             EBUF$=KEYWORD$(REPEAT.%):GoSub ERRORS
  449.         endw
  450.     else
  451.         EBUF$=KEYWORD$(REPEAT.%):GoSub ERRORS
  452.     endw
  453. endp
  454. proc _ENDL
  455.     when LOOP%>0
  456.         GoSub POP
  457.         when KEYWORD%=REPEAT.% OR KEYWORD%=LOOP.%
  458.             GoSub PARSER:C.$=TEXT$:GoSub _Fold|
  459.             LOOP%=LOOP%-1
  460.             when LOOPS%(LOOP%+1)>0
  461.                 TK%=LOOPS%(LOOP%+1)
  462.                 when C.$="when" OR C.$="unless"
  463.                     FLAG%=ABS(C.$="when"):GoSub OUT_LINE
  464.                 else
  465.                     EBUF$=KEYWORD$(WHEN.%):GoSub ERRORS
  466.                 endw
  467.             else
  468.                 TK%=LOOPS%(LOOP%+1)*-1
  469.                 when C.$="when" OR C.$="unless"
  470.                     FLAG%=ABS(C.$="when")
  471.                 else
  472.                     FLAG%=4:PBUF$="GOTO "
  473.                 endw
  474.                 GoSub OUT_LINE
  475.                 F.%=LEVEL%:GoSub POP:T.%=LEVEL%:GoSub POPOFF
  476.             endw
  477.         else
  478.             GoSub PUSH|
  479.             EBUF$=KEYWORD$(LOOP.%):GoSub ERRORS
  480.         endw
  481.     else
  482.         EBUF$=KEYWORD$(LOOP.%):GoSub ERRORS
  483.     endw
  484. endp
  485. proc _SWITCH
  486.     when C.LN.%>0
  487.         GoSub LEVEL:GoSub LEVEL:GoSub LEVEL|
  488.         SWITCH$(SWITCH%+1)=COND$|
  489.         SWITCH%=SWITCH%+1
  490.     else
  491.         EBUF$="operand":GoSub ERRORS
  492.     endw
  493. endp
  494. proc _CASE
  495.     GoSub POP
  496.     when KEYWORD%=SWITCH.% AND SWITCH%>0
  497.         when C.LN.%>0
  498.             XN%=XN%+1:XN.%(XN%)=LEVEL%|
  499.             GoSub LEVEL:FLAG%=4|
  500.             PBUF$="IF("+SWITCH$(SWITCH%)+"<>"+COND$+") GOTO "|
  501.             GoSub OUT_LINE
  502.         else
  503.             EBUF$="operand":GoSub ERRORS
  504.         endw
  505.     else
  506.         GoSub PUSH|
  507.         EBUF$=KEYWORD$(SWITCH.%):GoSub ERRORS
  508.     endw
  509. endp
  510. proc _BREAK
  511.     GoSub POP
  512.     when KEYWORD%=SWITCH.%
  513.         F.%=LEVEL%:GoSub POP:T.%=LEVEL%:TK%=T.%|
  514.         FLAG%=4:PBUF$="GOTO ":GoSub OUT_LINE|
  515.         KEYWORD%=SWITCH.%|
  516.         LEVEL%=T.%:GoSub PUSH|
  517.         LEVEL%=F.%:GoSub PUSH
  518.     else
  519.         GoSub PUSH|
  520.         EBUF$=KEYWORD$(SWITCH.%):GoSub ERRORS
  521.     endw
  522. endp
  523. proc _ENDC
  524.     GoSub POP
  525.     when KEYWORD%=SWITCH.%
  526.         F.%=LEVEL%:GoSub POP:T.%=LEVEL%:GoSub POP|
  527.         GoSub POPOFF:SWITCH%=SWITCH%-1
  528.     else
  529.         GoSub PUSH|
  530.         EBUF$=KEYWORD$(SWITCH.%):GoSub ERRORS
  531.     endw
  532. endp
  533. proc OUT_LINE
  534.     '
  535.     ' Build and output lines to the temp file.
  536.     '
  537.     when FLAG%<2 AND C.LN.%=0
  538.         EBUF$="condition":GoSub ERRORS
  539.     else
  540.         NUM%=NUM%+1:OFFSET%=1
  541.         IF(FLAG%<2 OR FLAG%>3)THEN LEVEL$=STR$(TK%):MID$(LEVEL$,1,1)="@"
  542.         switch FLAG%
  543.         case 0
  544.             PBUF$="IF("+COND$+") GOTO "+LEVEL$
  545.         break
  546.         case 1
  547.             PBUF$="IF NOT("+COND$+") GOTO "+LEVEL$
  548.         break
  549.         case 2
  550.             GoSub STACK_IT
  551.         break
  552.         case 4
  553.             PBUF$=PBUF$+LEVEL$
  554.         endc
  555.         PRINT #T.FILE%,RIGHT$(STR$(NUM%),LEN(STR$(NUM%))-1);SKIP$;PBUF$;COMMENT$
  556.         IF(XN%>0 AND FLAG%<>2)THEN GoSub STORE_IT
  557.     endw
  558.     COMMENT$="":PBUF$="":LEVEL$=""
  559. endp
  560. proc STORE_IT
  561.     '
  562.     ' Pop off the target place savers and make tokens of them.
  563.     '
  564.     OFFSET%=0|
  565.     FOR I%=1 TO XN%|
  566.         LEVEL$=STR$(XN.%(I%)):MID$(LEVEL$,1,1)="@"|
  567.         GoSub STACK_IT|
  568.     NEXT I%|
  569.     XN%=0
  570. endp
  571. proc STACK_IT
  572.     '
  573.     ' Store the tokens and labels with their corresponding line numbers.
  574.     '
  575.     STACK.%=STACK.%+1|
  576.     STACK%(STACK.%)=NUM%+OFFSET%|
  577.     STACK$(STACK.%)=LEVEL$|
  578.     IF(COMPIL%)THEN NUM.%(STACK.%)=NUM%+OFFSET%
  579.     OFFSET%=0
  580. endp
  581. proc PASS_2
  582.     '
  583.     ' This is the second phase of processing.
  584.     ' First the stack has to be sorted in ascending order,
  585.     ' so we can use a binary search on it.
  586.     ' Then we read the temp file and process it a line at
  587.     ' a time.
  588.     '
  589.     GoSub SORT|
  590.     OFFSET%=2|
  591.     Open"I",T.FILE%,T.FILE$|
  592.     Open"O",O.FILE%,O.FILE$
  593.     loop
  594.         LINE INPUT #T.FILE%,BUF$|
  595.         GoSub PROCESS_1
  596.     until EOF(T.FILE%)
  597. endp
  598. proc PROCESS_1
  599.     '
  600.     ' Scan the input line a word at a time.
  601.     ' The first word will be the line number.
  602.     ' Then write the line to the output file.
  603.     '
  604.     INDEX%=0:ONFLAG%=0:LN.%=LEN(BUF$)|
  605.     GoSub PARSER|
  606.     IF(COMPIL%)THEN GoSub COMPIL
  607.     while FIRST%<=LEN(BUF$)
  608.         unless LEN(TEXT$)>7 OR LEN(TEXT$)<2 OR VAL(TEXT$)>0
  609.             GoSub FIND_IT
  610.         endu
  611.         GoSub PARSER
  612.     wend
  613.     PRINT #O.FILE%,BUF$
  614. endp
  615. proc COMPIL
  616.     '
  617.     ' Binary search the number stack to see if the line number is used.
  618.     '
  619.     TEXT%=VAL(TEXT$):HIGH%=STACK.%+1:LOW%=0
  620.     unless TEXT%<NUM.%(1) OR TEXT%>NUM.%(STACK.%)
  621.         while((HIGH%-LOW%)>1)|
  622.             I%=(HIGH%+LOW%)\2
  623.             when NUM.%(I%)=TEXT%
  624.                 TEXT%=-1:LOW%=HIGH%
  625.             else when NUM.%(I%)<TEXT%
  626.                 LOW%=I%
  627.             else
  628.                 HIGH%=I%
  629.             endw
  630.         wend
  631.     endu
  632.     IF(TEXT%>0)THEN BUF$=SPACE$(LEN(TEXT$)+1)+COND$
  633. endp
  634. proc FIND_IT
  635.     '
  636.     ' Look for BASIC'S keywords and get the token/label to replace
  637.     ' with the corresponding line number.
  638.     '
  639.     C.$=TEXT$:GoSub _Fold
  640.     when C.$="on"
  641.         ONFLAG%=-1
  642.     else when LEN(C.$)>3
  643.         unless INSTR(BASIC$,C.$)=0 OR COLN%
  644.             GoSub PARSER:I$=LEFT$(TEXT$,1)
  645.             unless I$="@" OR LEN(TEXT$)<>4
  646.                 C.$=TEXT$:GoSub _Fold|
  647.                 IF(C.$="else")THEN RETURN
  648.             endu
  649.             unless I$="0" AND ONFLAG%
  650.                 IF(ONFLAG%)THEN GoSub ON_FLAG ELSE GoSub SEARCH
  651.             endu
  652.         endu
  653.     endw
  654. endp
  655. proc ON_FLAG
  656.     '
  657.     ' Resolve the `ON GOTO' or `ON GoSub' statements. 
  658.     ' Parse all the way to the end of the input line.
  659.     '
  660.     OFFSET%=1
  661.     while(FIRST%<=LEN(BUF$))
  662.         IF(TEXT$<>"")THEN GoSub SEARCH
  663.         GoSub PARSER
  664.     wend
  665.     OFFSET%=2    
  666. endp
  667. proc SEARCH
  668.     '
  669.     ' Binary search the token stack to get the corresponding line number.
  670.     '
  671.     HIGH%=STACK.%+1:LOW%=0:FIND%=-1
  672.     while((HIGH%-LOW%)>1)|
  673.         I%=(HIGH%+LOW%)\2
  674.         when STACK$(I%)=TEXT$
  675.             FIND%=STACK%(I%):LOW%=HIGH%
  676.         else when STACK$(I%)<TEXT$
  677.             LOW%=I%
  678.         else
  679.             HIGH%=I%
  680.         endw
  681.     wend
  682.     when FIND%>0
  683.         GoSub STUFF_IT
  684.     else when TEXT$<>""
  685.         ERRORS%=ERRORS%+1|
  686.         PRINT"MISSING LABEL (";TEXT$;")"
  687.     endw
  688. endp
  689. proc STUFF_IT
  690.     '
  691.     ' Replace the token/label with the corresponding line number.
  692.     '
  693.     NUM$=STR$(FIND%):SP$=""|
  694.     L$=LEFT$(BUF$,FIRST%-OFFSET%)
  695.     IF(LEFT$(COND$,1)<>" " AND LEFT$(COND$,1)<>":" AND ONFLAG%=0)THEN SP$=" "
  696.     BUF$=L$+NUM$+SP$+COND$|
  697.     INDEX%=LEN(L$)+LEN(NUM$)|
  698.     LN.%=LEN(BUF$)
  699. endp
  700. proc SORT
  701.     '
  702.     ' Shell-Metzner in-memory sort of the token/label stack.
  703.     ' Sort the line number stack if the compile flag is set.
  704.     '
  705.     PT.%=STACK.%|
  706.     while (PT.%>0)|
  707.         PT.%=PT.%\2
  708.         when PT.%>0
  709.             JT.%=1:KT.%=STACK.%-PT.%|
  710.             while (JT.%<=KT.%)|
  711.                 LT.%=JT.%:CT.%=LT.%+PT.%
  712.                 while (LT.%>0 AND STACK$(LT.%)>=STACK$(CT.%))
  713.                     SWAP STACK$(LT.%),STACK$(CT.%)|
  714.                     SWAP STACK%(LT.%),STACK%(CT.%)
  715.                     CT.%=LT.%:LT.%=LT.%-PT.%:LT.%=LT.%*(1+(LT.%<0))
  716.                 wend
  717.                 when COMPIL%
  718.                     LT.%=JT.%:CT.%=LT.%+PT.%
  719.                     while (LT.%>0 AND NUM.%(LT.%)>=NUM.%(CT.%))
  720.                         SWAP NUM.%(LT.%),NUM.%(CT.%)|
  721.                         CT.%=LT.%:LT.%=LT.%-PT.%:LT.%=LT.%*(1+(LT.%<0))
  722.                     wend
  723.                 endw                        
  724.                 JT.%=JT.%+1|
  725.             wend
  726.         endw
  727.     wend
  728. endp
  729. '------------------------------------------------------
  730. '- ** Sub-Routine Division                            -
  731. '------------------------------------------------------
  732. proc PARSER
  733.     C.LN.%=0:I.%=0:COLN%=0:II%=32:TEXT%=0:COND$=""|
  734.     TRM$=TM$+CHR$(58*ABS(INDEX%>0))
  735.     while(INSTR(TRM$,CHR$(II%))>0)|
  736.         INDEX%=INDEX%+1|
  737.         IF(INDEX%<=LEN(BUF$))THEN II%=ASC(MID$(BUF$,INDEX%,1)) ELSE II%=7
  738.     wend|
  739.     FIRST%=INDEX%
  740.     while(II%<>32 AND II%<>7)
  741.         when INSTR(TRM$,CHR$(II%))>0 AND TEXT%=0
  742.             COLN%=(CHR$(II%)=":"):I.%=1:II%=32
  743.         else 
  744.             when II%=34 OR II%=40 OR II%=41
  745.                 IF(II%=34)THEN INDEX%=INSTR(INDEX%+1,BUF$,CHR$(34))
  746.                 IF(II%=40)THEN TEXT%=TEXT%+1 ELSE IF(II%=41)THEN TEXT%=TEXT%-1
  747.             endw
  748.             loop 
  749.                 INDEX%=INDEX%+1|
  750.                 IF(INDEX%<=LEN(BUF$))THEN II%=ASC(MID$(BUF$,INDEX%,1)) ELSE II%=7
  751.             endl unless II%=32 AND TEXT%<>0
  752.         endw
  753.     wend
  754.     TEXT$=MID$(BUF$,FIRST%,INDEX%-FIRST%)|
  755.     IF(LEN(BUF$)>INDEX%)THEN COND$=RIGHT$(BUF$,(LEN(BUF$)-INDEX%)+I.%):C.LN.%=LEN(COND$)
  756. endp
  757. proc FILENAMES
  758.     LINE INPUT"INPUT FILE [.P]:",I.FILE$
  759.     unless I.FILE$=""
  760.         COMPIL%=(INSTR(I.FILE$,"/")>0)
  761.         IF(COMPIL%)THEN I.FILE$=LEFT$(I.FILE$,LEN(I.FILE$)-1)
  762.         IF(INSTR(I.FILE$,DOT$)=0)THEN I.FILE$=I.FILE$+IEXT$
  763.         LK.$=I.FILE$:LK.%=I.FILE%:GoSub _Lookup:I.FILE%=LK.%|
  764.         GOOD%=(I.FILE%<>FALSE%)
  765.         unless GOOD%=FALSE%
  766.             I%=INSTR(1,I.FILE$,DOT$)
  767.             IF(I%=0)THEN I%=LEN(I.FILE$)+1
  768.             E.FILE$=LEFT$(I.FILE$,I%-1)|
  769.             LINE INPUT"OUTPUT FILE [.BAS]:",O.FILE$
  770.             IF(O.FILE$="")THEN O.FILE$=E.FILE$
  771.             IF(INSTR(O.FILE$,DOT$)=0)THEN O.FILE$=O.FILE$+OEXT$
  772.             E.FILE$=E.FILE$+EEXT$
  773.         endu
  774.     endu
  775. endp
  776. proc INCLUDES
  777.     GoSub FILES
  778.     when FILE.%>0
  779.         Open"I",FILE.%,FILE$|
  780.         FILE%=FILE.%
  781.     else
  782.         EBUF$="include "+FILE$:GoSub ERRORS
  783.     endw
  784. endp
  785. proc SUBROUTINE
  786.     GoSub FILES
  787.     when FILE.%>0
  788.         TEXT%=0
  789.         while(TEXT%<INCS%)
  790.             TEXT%=TEXT%+1|
  791.             IF(FILE$=INC$(TEXT%))THEN TEXT%=INCS%+1
  792.         wend
  793.         IF(TEXT%=INCS%)THEN INCS%=INCS%+1:INC$(INCS%)=FILE$
  794.     else
  795.         EBUF$="include "+FILE$:GoSub ERRORS
  796.     endw
  797. endp
  798. proc FILES
  799.     FILE$=RIGHT$(TEXT$,LEN(TEXT$)-1)|
  800.     IF(INSTR(FILE$,DOT$)=0)THEN FILE$=FILE$+INCL$
  801.     FILE.%=FILE%+1|
  802.     LK.$=FILE$:LK.%=FILE.%:GoSub _Lookup:FILE.%=LK.%
  803. endp
  804. proc ERRORS
  805.     ERRORS%=ERRORS%+1|
  806.     EBUF$="ERR#"+STR$(ERRORS%)+" MISSING ("+EBUF$+") PROC <"+LPROC$+">"|
  807.     EBUF$=EBUF$+" AT"+STR$(KERR%)|
  808.     PRINT EBUF$:PRINT #E.FILE%,EBUF$
  809. endp
  810. proc _Fold
  811.     f.0%=1
  812.     while(f.0%<=LEN(C.$))
  813.         f.2%=ASC(MID$(C.$,f.0%,1))
  814.         f.2%=f.2%+(32*ABS(f.2%>64 AND f.2%<91))
  815.         MID$(C.$,f.0%,1)=CHR$(f.2%):f.0%=f.0%+1
  816.     wend
  817. endp
  818. proc _Lookup
  819.     OPEN"R",LK.%,LK.$:L.K!=LOF(LK.%):CLOSE LK.%
  820.     IF(L.K!<1)THEN LK.%=0:KILL LK.$
  821. endp
  822.