home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / preprss.lbr / BMLP.PZ / BMLP.P
Encoding:
Text File  |  1993-10-25  |  9.9 KB  |  342 lines
  1. BMLP.P
  2.  
  3. '-----------------------------------------------------------------------------
  4. '- (C) Bendorf Associates, 1984-85                                           -
  5. '-----------------------------------------------------------------------------
  6. '- Program:BMLP (BASIC MACRO LANGUAGE PREPROCESSOR)
  7. '- System :PPE 
  8. '- Module :TOOLS
  9. '- Task   :EXPAND MACROS USING LOCAL OR LIBRARY DEFINITIONS.
  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. '-----------------------------------------------------------------------------
  16. '- ** Data Division                                                          -
  17. '-----------------------------------------------------------------------------
  18. SIGN$    = "$"
  19. DOT$     = "."
  20. OEXT$    = ".P"         ' Output file default extension
  21. IEXT$    = ".M"         ' Input file default extension
  22. LEXT$    = ".ML"        ' Library file default extension
  23. SOURCE%  = 2            ' Input file number
  24. O.FILE%  = 1            ' Output file number
  25. I.FILE%  = 2
  26. ERRORS%  = 0
  27. FALSE%   = 0
  28. TRUE%    = NOT FALSE%
  29. EXPAND%  = TRUE%
  30. STORE.%  = 0
  31. NEST%    = 1
  32. DIM FILE.%(50)      ' TEMPORARY STACK OF POINTERS TO THE NEXT SUBSCRIPT
  33.                     ' OF STORE$ ARRAY. ALLOWS NESTED MACROS AND LIBRARIES.
  34. DIM PARM$(500)      ' TEMPORARY STORAGE OF PARAMETERS TO PASS TO MACROS.
  35. DIM PARM%(100)      ' ARRAY OF POINTERS TO PARAMETER STORAGE.
  36.  
  37. DIM MACRO$(100)     ' STORAGE FOR MACRO NAMES.
  38. DIM MACRO%(100)     ' ARRAY OF POINTERS TO FIRST CODE LOCATION IN STORE$ ARRAY 
  39.                     ' FOR EACH MACRO NAME IN THE MACRO$ ARRAY. 
  40. DIM STORE$(1000)    ' STORAGE FOR MACRO TEXT.
  41. DIM SUBS$(50)       ' STORAGE FOR MACRO SUBROUTINE NAMES.
  42. '
  43. '------------------------------------------------------
  44. '- ** Procedure Division                              -
  45. '------------------------------------------------------
  46. '
  47. prog BMLP
  48.     PRINT "BMLP   V1.0B (C) BENDORF ASSOCIATES, 1984-85"
  49.     PRINT
  50.     GoSub FILENAMES
  51.     when I.FILE%>0
  52.         GoSub PROCESS-SOURCE-FILE
  53.         CLOSE
  54.         when ERRORS%>0
  55.             KILL O.FILE$
  56.             PRINT O.FILE$;" ABORTED WITH ";STR$(ERRORS%);" ERROR(S)."
  57.         else
  58.             PRINT"<";O.FILE$;"> DONE!"
  59.         endw
  60.     else when I.FILE$<>""
  61.         PRINT"CANNOT OPEN ";I.FILE$
  62.     endw
  63. pend
  64. proc PROCESS-SOURCE-FILE
  65.     OPEN"O",O.FILE%,O.FILE$
  66.     OPEN"I",I.FILE%,I.FILE$
  67.     FILE.%(NEST%)=-1
  68.     loop unless NEST%=0
  69.         while ENDOFF%=FALSE%
  70.             GoSub INPUT-BUFFER
  71.             when LN.%>1 AND ENDOFF%=FALSE%
  72.                 GoSub INSERT-PARAMETERS
  73.                 GoSub PARSE-INPUT-LINE
  74.             else when SKIP% AND I.FILE%=SOURCE%
  75.                 PRINT #O.FILE%,BUF$
  76.             endw
  77.         wend
  78.         IF(NEST%=1)THEN FIRST%=0 ELSE FIRST%=PARM%(NEST%-1)
  79.         LAST%=PARM%(NEST%) 
  80.         PARM%(NEST%)=0
  81.         while (FIRST%<LAST%)
  82.             PARM$(LAST%)=""
  83.             LAST%=LAST%-1
  84.         wend
  85.         when FILE.%(NEST%)<0 AND NEST%>1 AND I.FILE%>SOURCE%
  86.             CLOSE #I.FILE%
  87.             I.FILE%=I.FILE%-1
  88.         else
  89.             POINTER%=FILE.%(NEST%-1)
  90.         endw
  91.         NEST%=NEST%-1
  92.         ENDOFF%=FALSE%
  93.         unless NEST%>0 OR SUBS%=LAST.S%
  94.             LAST.S%=LAST.S%+1
  95.             TEXT$=SUBS$(LAST.S%)
  96.             GoSub FIND-MACRO-NAME
  97.             when FOUND%
  98.                 FILE.%(NEST%+1)=FIND%:POINTER%=FIND%
  99.                 NEST%=NEST%+1
  100.             else
  101.                 EBUF$="SUBROUTINE ("+TEXT$+") NOT FOUND!"
  102.                 GoSub ERRORS
  103.             endw
  104.         endu
  105.     endl unless NEST%>0
  106. endp
  107. '
  108. '------------------------------------------------------
  109. '- ** SubRoutine Division                             -
  110. '------------------------------------------------------
  111. '
  112. proc PARSE-INPUT-LINE
  113.     GoSub PARSER
  114.     GoSub LCASE
  115.     when LEFT$(TEXT$,1)=SIGN$
  116.         TEXT$=RIGHT$(TEXT$,LEN(TEXT$)-1)
  117.         when TEXT$="if"
  118.             GoSub SET-CONDITIONAL
  119.         else when TEXT$="else" 
  120.             EXPAND%=(EXPAND%=FALSE%)
  121.         else when TEXT$="end"
  122.             EXPAND%=TRUE%
  123.         else when LEFT$(TEXT$,1)=SIGN$
  124.             TEXT$=RIGHT$(TEXT$,LEN(TEXT$)-1)
  125.             GoSub SUBROUTINE
  126.         else when EXPAND%
  127.             GoSub EXPAND-MACRO
  128.         endw
  129.     else when TEXT$="macro"
  130.         GoSub INPUT-A-MACRO
  131.     else when TEXT$="library"
  132.         GoSub LIBRARY
  133.     else when EXPAND% AND I.FILE%=SOURCE%
  134.         PRINT #O.FILE%,BUF$
  135.     endw
  136. endp
  137. proc INSERT-PARAMETERS
  138.     LB%=INSTR(1,BUF$,"[")
  139.     while (LB%>0)
  140.         RB%=INSTR(LB%,BUF$,"]")
  141.         when RB%>0
  142.             INSERT$=PARM$(PARM%(NEST%-1)+VAL(MID$(BUF$,LB%+1,RB%-LB%)))
  143.             BUF$=LEFT$(BUF$,LB%-1)+INSERT$+RIGHT$(BUF$,LEN(BUF$)-RB%)
  144.             LB%=INSTR(RB%,BUF$,"[")
  145.         else
  146.             LB%=0
  147.         endw
  148.     wend
  149.     LN.%=LEN(BUF$)
  150. endp
  151. proc SET-CONDITIONAL
  152.     GoSub PARSER
  153.     L$=TEXT$:OP$=""
  154.     IF(L$="=" OR L$="#" OR L$="<>")THEN OP$=L$:L$=""
  155.     GoSub PARSER
  156.     when TEXT$="" 
  157.         OP$="<>":R$=""
  158.     else when OP$=""
  159.         OP$=TEXT$
  160.         GoSub PARSER
  161.         R$=TEXT$
  162.     endw
  163.     when OP$="="
  164.         EXPAND%=(R$=L$)
  165.     else when OP$="<>" OR OP$="#"
  166.         EXPAND%=(R$<>L$)
  167.     else
  168.         EBUF$="ILLEGAL OPERATOR("+OP$+")"
  169.         GoSub ERRORS
  170.     endw
  171. endp
  172. proc EXPAND-MACRO
  173.     GoSub FIND-MACRO-NAME
  174.     when FOUND%
  175.         IF(FILE.%(NEST%)=>0)THEN FILE.%(NEST%)=POINTER%
  176.         POINTER%=FIND%
  177.         NEST%=NEST%+1
  178.         FILE.%(NEST%)=FIND%
  179.         PARM%(NEST%)=PARM%(NEST%-1)
  180.         GoSub LOAD-PARAMETERS
  181.     else
  182.         EBUF$="MACRO ("+TEXT$+") NOT DEFINED."
  183.         GoSub ERRORS
  184.     endw
  185. endp
  186. proc LOAD-PARAMETERS
  187.     PASS%=FALSE%
  188.     while PASS%=FALSE%
  189.         PASS%=(CON%=FALSE%)
  190.         GoSub PARSER
  191.         while (FIRST%<=LN.%)
  192.             PARM%(NEST%)=PARM%(NEST%)+1
  193.             PARM$(PARM%(NEST%))=TEXT$
  194.             GoSub PARSER
  195.         wend
  196.         IF(CON%)THEN GoSub INPUT-SOURCE
  197.     wend
  198. endp
  199. proc INPUT-BUFFER
  200.     when FILE.%(NEST%)<0
  201.         GoSub INPUT-SOURCE
  202.     else
  203.         BUF$=STORE$(POINTER%)
  204.         POINTER%=POINTER%+1
  205.         ENDOFF%=(BUF$=CHR$(7))
  206.         SKIP%=FALSE%
  207.         CON%=SKIP%
  208.         LN.%=LEN(BUF$)
  209.         INDEX%=0
  210.     endw
  211. endp
  212. proc INPUT-SOURCE
  213.     INDEX%=0:CON%=FALSE%
  214.     LINE INPUT #I.FILE%,BUF$
  215.     ENDOFF%=EOF(I.FILE%)
  216.     LN.%=LEN(BUF$):I%=1:II%=0
  217.     while (I%>II% AND I%<LEN(BUF$))
  218.         II%=I%:I%=I%+ABS(MID$(BUF$,I%,1)=" " OR MID$(BUF$,I%,1)=CHR$(9))
  219.     wend
  220.     II%=LN.%+1
  221.     while (II%>LN.% AND LN.%>I%)
  222.         II%=LN.%:LN.%=LN.%+(MID$(BUF$,LN.%,1)=" " OR MID$(BUF$,LN.%,1)=CHR$(9))
  223.     wend
  224.     BUF$=MID$(BUF$,I%,LN.%):LN.%=LEN(BUF$)
  225.     SKIP%=(MID$(BUF$,1,1)="'" OR MID$(BUF$,1,1)=";" OR LEN(BUF$)<2)
  226.     when SKIP%
  227.         LN.%=1
  228.     else when RIGHT$(BUF$,2)="\\"
  229.         CON%=TRUE%
  230.         BUF$=LEFT$(BUF$,LEN(BUF$)-2)
  231.         LN.%=LEN(BUF$)
  232.     endw
  233. endp
  234. proc FIND-MACRO-NAME
  235.     FIND%=FALSE%:THIS.M%=0
  236.     FOR M%=1 TO LAST.M%
  237.         IF(MACRO$(M%)=TEXT$)THEN THIS.M%=M%:M%=LAST.M%+1
  238.     NEXT M%
  239.     FOUND%=(THIS.M%>0)
  240.     IF(FOUND%)THEN FIND%=MACRO%(THIS.M%)
  241. endp
  242. proc INPUT-A-MACRO
  243.     GoSub PARSER
  244.     GoSub LCASE
  245.     GoSub FIND-MACRO-NAME
  246.     when FOUND%
  247.         MACRO%(THIS.M%)=STORE.%+1
  248.     else
  249.         MACRO$(LAST.M%+1)=TEXT$
  250.         MACRO%(LAST.M%+1)=STORE.%+1
  251.         LAST.M%=LAST.M%+1
  252.     endw
  253.     GoSub INPUT-SOURCE
  254.     GoSub PARSER
  255.     GoSub LCASE
  256.     while (TEXT$<>"endm" AND ENDOFF%=FALSE%)
  257.         IF(SKIP%=FALSE%)THEN GoSub STORE-MACRO-CODE
  258.         GoSub INPUT-SOURCE
  259.         IF(SKIP%=FALSE%)THEN GoSub PARSER:GoSub LCASE
  260.     wend
  261.     BUF$=CHR$(7)
  262.     GoSub STORE-MACRO-CODE
  263. endp
  264. proc STORE-MACRO-CODE
  265.     STORE.%=STORE.%+1
  266.     STORE$(STORE.%)=BUF$
  267. endp
  268. proc PARSER
  269.     I%=32
  270.     while (I%=32)
  271.         INDEX%=INDEX%+1
  272.         IF(INDEX%<=LEN(BUF$))THEN I%=ASC(MID$(BUF$,INDEX%,1)) ELSE I%=7
  273.         I%=I%+(23*ABS(I%=9))
  274.     wend
  275.     FIRST%=INDEX%
  276.     while (I%<>32 AND I%<>7)
  277.         when I%=44 OR I%=9
  278.             I%=32 
  279.         else 
  280.             when I%=34
  281.                 X%=INSTR(INDEX%+1,BUF$,CHR$(34))
  282.                 IF(X%>INDEX%)THEN INDEX%=X%
  283.             endw
  284.             INDEX%=INDEX%+1
  285.             IF(INDEX%<=LEN(BUF$))THEN I%=ASC(MID$(BUF$,INDEX%,1)) ELSE I%=7
  286.         endw
  287.     wend
  288.     TEXT$=MID$(BUF$,FIRST%,INDEX%-FIRST%)
  289. endp
  290. proc FILENAMES
  291.     LINE INPUT"INPUT FILE [.M]:",I.FILE$
  292.     unless I.FILE$=""
  293.         IF(INSTR(I.FILE$,DOT$)=0)THEN I.FILE$=I.FILE$+IEXT$
  294.         LK.$=I.FILE$:LK.%=I.FILE%:GoSub _Lookup:I.FILE%=LK.%
  295.         unless I.FILE%=FALSE%
  296.             I%=INSTR(1,I.FILE$,DOT$)
  297.             IF(I%=0)THEN I%=LEN(I.FILE$)+1
  298.             FILE$=LEFT$(I.FILE$,I%-1)
  299.             LINE INPUT"OUTPUT FILE [.P]:",O.FILE$
  300.             IF(O.FILE$="")THEN O.FILE$=FILE$
  301.             IF(INSTR(O.FILE$,DOT$)=0)THEN O.FILE$=O.FILE$+OEXT$
  302.         endu
  303.     endu
  304. endp
  305. proc ERRORS
  306.     ERRORS%=ERRORS%+1
  307.     EBUF$="ERR#"+STR$(ERRORS%)+" ("+EBUF$+")"
  308.     PRINT EBUF$
  309. endp
  310. proc LCASE
  311.     I%=1
  312.     while (I%<=LEN(TEXT$))
  313.         II%=ASC(MID$(TEXT$,I%,1))
  314.         MID$(TEXT$,I%,1)=CHR$(II%+(32*ABS(II%>64 AND II%<91))):I%=I%+1
  315.     wend
  316. endp
  317. proc LIBRARY
  318.     GoSub PARSER
  319.     unless TEXT$=""
  320.         IF(INSTR(TEXT$,DOT$)=0)THEN TEXT$=TEXT$+LEXT$
  321.         LK.%=I.FILE%+1:LK.$=TEXT$:GoSub _Lookup
  322.         when LK.%>0
  323.             OPEN"I",LK.%,LK.$:I.FILE%=LK.%
  324.             NEST%=NEST%+1:FILE.%(NEST%)=-1
  325.         else
  326.             EBUF$="LIBRARY ("+LK.$+") NOT FOUND!"
  327.             GoSub ERRORS
  328.         endw
  329.     endu
  330. endp
  331. proc _Lookup
  332.     OPEN"R",LK.%,LK.$:L.K!=LOF(LK.%):CLOSE LK.%
  333.     IF(L.K!<1)THEN LK.%=0:KILL LK.$
  334. endp
  335. proc SUBROUTINE
  336.     S%=0
  337.     while (S%<SUBS%)
  338.         S%=S%+1:IF(TEXT$=SUBS$(S%))THEN S%=SUBS%+1
  339.     wend
  340.     IF(S%=SUBS%)THEN SUBS%=SUBS%+1:SUBS$(SUBS%)=TEXT$
  341. endp
  342.