home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / cb80 / cap-cb80.ark / CAP-CB80.BAS next >
BASIC Source File  |  1984-01-25  |  10KB  |  394 lines
  1. rem CAP-CB80.BAS  Ver. 1.1  23 Jan 84\
  2. \
  3. Maps all CB80 reserved words to upper case.  This program will process source\
  4. code files for V1.3 and V1.4 of CB80 and can be compiled with either version.\
  5. \
  6. Note: 25 Jan 84.  If compiled with V 1.3, the time from the last apparent\
  7. record print to disk may be excessive.  This is due to a documented problem\
  8. with the GET function in V 1.3.\
  9. \
  10. By:  Phil Cary, Mesilla Valley RCP/M, Las Cruces, NM   (505) 522-8856 \
  11.      based on an idea by David Ransen, Baton Rouge, LA\
  12. \
  13. Known limitations:\
  14.     1. All remarks must begin with REM or rem followed by a space(not TAB)\
  15.        Remarks may be continued with the continuation character(\),\
  16.        however, remarks following a \ on a line of code will be processed\
  17.        and any keywords converted to uppercase unless rem is used.  Do not\
  18.        use REMARK or remark to start a remark.\
  19. \
  20.     2. A maximum of three quoted strings within a line will be processed\
  21.        correctly.  Keywords within additional quoted strings on the line\
  22.        will be converted to upper case.  This should be adequate for\
  23.        normal applications.  If this program is run on itself, an example\
  24.        of this can be found in the data area at the end of the program.\
  25. \
  26. Note that when this program is run on itself, there will be some undesired\
  27. results due to the way keywords are used within the program.\
  28. \
  29. Please report any bugs or enhancments to Mesilla Valley RCP/M, (505) 522-8856
  30.  
  31.  
  32. rem following notice required in composite program by Digital Research, Inc.
  33.  
  34.     license.notice$="Portions of this program (c)1982 Digital Research Inc"
  35.  
  36. rem Define constants
  37.  
  38.     false% = 0
  39.     true% = not false%
  40.  
  41.     view% = false%
  42.     examine% = false%
  43.  
  44.     record.number% = 1
  45.     cr% = 0dh
  46.     lf% = 0ah
  47.     quote.mark% = 22h
  48.     alpha.min% = 41h
  49.     ctrlc% = 03h
  50.  
  51.     dim keyword$(122)    rem 123 CB80 reserved words
  52.  
  53.     for i% = 0 to 122
  54.  
  55.         read keyword$(i%)
  56.  
  57.     next i%
  58.  
  59. file.in:
  60.  
  61.     input "Input Filename (.BAS assumed): " ; infile$
  62.     input.file$ = ucase$(infile$) + ".BAS"
  63.  
  64.     if not size(input.file$)\
  65.     then print "File does not exist.  Check spelling." : goto file.in\
  66.     else open input.file$ as 1 buff 64
  67.  
  68.     if end # 1\
  69.     then all.done
  70.  
  71. file.out:
  72.  
  73.     print 
  74.     input "Output Filename (.BAS assumed):" ; outfile$
  75.             output.file$ = ucase$(outfile$) + ".BAS"
  76.  
  77.     if output.file$ = input.file$\
  78.     then print "Output filename same as input.  Choose another name." :\
  79.         goto file.out
  80.  
  81.     if not size(output.file$)\
  82.     then create output.file$ as 2 buff 64 : goto startup\
  83.     else print : print output.file$; :\
  84.         input " exists. Do you want to overwrite it?"; line answer$
  85.     
  86.     if ucase$(left$(answer$,1)) = "Y"\
  87.     then create output.file$ as 2 buff 64\
  88.     else goto file.out
  89.  
  90. startup:
  91.  
  92.     print : print "Do you want to View or Examine the processing?";
  93.     input " <N>o, <V>iew, <E>xamine:"; line answer$
  94.  
  95.     if ucase$(left$(answer$,1)) = "V"\
  96.     then view% = true% : goto restart
  97.  
  98.     if ucase$(left$(answer$,1)) = "E"\
  99.     then view% = true% : examine% = true% : print :\
  100.         print "Enter ^C to abort, any other key for next record." :\
  101.         print : goto restart
  102.  
  103.     print "Processing file."
  104.  
  105. restart:
  106.  
  107. def NEW.RECORD$(record$,position%,keyword$)
  108.  
  109.     word$ = mid$(record$,position%,len(keyword$))
  110.     caps.word$ = ucase$(word$)
  111.     NEW.RECORD$ = left$(record$,(position% -1)) + caps.word$ + \
  112.         right$(record$,(len(record$) - position% - len(word$) + 1))
  113.  
  114. fend
  115.  
  116. process.record:
  117.  
  118.     if(not view% and not examine%)\
  119.     then print "Record number: "; record.number%; chr$(cr%); :\
  120.         record.number% = record.number% + 1
  121.  
  122.     quote.one% = 0
  123.     quote.two% = 0
  124.     quote.three% = 0
  125.     quote.four% = 0
  126.     quote.five% = 0
  127.     quote.six% = 0
  128.  
  129.     end.record% = false%
  130.     record$ = ""
  131.     record.position% = 0
  132.  
  133.     gosub get.record
  134.  
  135.     rem Mark location of quoted strings
  136.  
  137.     if quote.position% <> 0\
  138.     then quote.one% = quote.position% : gosub get.record\
  139.     else goto got.record
  140.  
  141.     if quote.position% <> 0\
  142.     then quote.two% = quote.position% : gosub get.record\
  143.     else goto got.record
  144.  
  145.     if quote.position% <> 0\
  146.     then quote.three% = quote.position% : gosub get.record\
  147.     else goto got.record
  148.  
  149.     if quote.position% <> 0\
  150.     then quote.four% = quote.position% : gosub get.record\
  151.     else goto got.record
  152.  
  153.     if quote.position% <> 0\
  154.     then quote.five% = quote.position% : gosub get.record\
  155.     else goto got.record
  156.  
  157.     if quote.position% <> 0\
  158.     then quote.six% = quote.position% : gosub get.record
  159.  
  160.  
  161. got.record:
  162.  
  163.     rem Ignore quotes over 6 and find end of record
  164.  
  165.     if not end.record%\
  166.     then gosub get.record
  167.  
  168.     if quote.position% <> 0\
  169.     then goto got.record
  170.  
  171.     rem Check for remark beginning line.  Note:  The following code\
  172.         segment will not be processed correctly if this program is run on\
  173.         itself because of the "REM ".
  174.  
  175.     if ucase$(left$(record$,4)) = "REM "\
  176.     then position% = 1 : dummy.word$ = "xxx " :\
  177.         record$ = NEW.RECORD$(record$,position%,dummy.word$) :\
  178.         gosub skip.remarks : goto process.record
  179.  
  180.     rem Check for remark at end of line( rem or REM )
  181.  
  182.     remark.position% = match("rem ",record$,1)
  183.     if remark.position% <> 0\
  184.     then gosub split.record : goto continue
  185.  
  186.     remark.position% = match("REM ",record$,1)
  187.     if remark.position% <> 0\
  188.     then gosub split.record
  189.  
  190. continue:
  191.     
  192.     for i% = 0 to 122
  193.  
  194.     start% = 1
  195.  
  196. scan:
  197.     position% = match(keyword$(i%),record$,start%)
  198.  
  199.     if position% = 0\
  200.     then goto no.match
  201.  
  202.     rem Skip quoted strings (up to 3 per line)
  203.  
  204.     if (position% > quote.one% and position% < quote.two%)\
  205.     then start% = position% + quote.two% : goto scan
  206.  
  207.     if (position% > quote.three% and position% < quote.four%)\
  208.     then start% = position% + quote.four% : goto scan
  209.  
  210.     if (position% > quote.five% and position% < quote.six%)\
  211.     then start% = position% + quote.six% : goto scan
  212.  
  213.     rem Keyword trailing part of label, move forward in record
  214.  
  215.     if position% > 1\
  216.     then if mid$(record$,position% - 1,1) = "."\
  217.     then start% = start% + position% : goto scan
  218.  
  219.     rem Keyword at end of record
  220.  
  221.     if position% = len(record$)-len(keyword$(i%))+1\
  222.     then gosub check.left : goto no.match
  223.  
  224.     rem Keyword first word on line
  225.  
  226.     if position% = 1\
  227.     then gosub check.right : goto scan
  228.  
  229.     rem Keyword with non-alpha character to the left
  230.  
  231.     if asc(mid$(record$,position% - 1,1)) < alpha.min%\
  232.     then gosub check.right
  233.  
  234.     rem Imbedded keyword, so move forward in record
  235.  
  236.     start% = start% + position%
  237.  
  238.     goto scan
  239.  
  240. no.match:
  241.  
  242.     next i%
  243.  
  244.     gosub put.record
  245.  
  246.     goto process.record
  247.  
  248. split.record:
  249.  
  250.     code.segment$ = left$(record$,remark.position% + 3)
  251.     remark.segment$ = right$(record$,len(record$)-len(code.segment$))
  252.  
  253.     record$ = code.segment$
  254.  
  255.     return
  256.  
  257. skip.remarks:
  258.  
  259.     if right$(record$,1) = "\"\
  260.     then gosub put.record : read #1; line record$ :\
  261.         if view%\
  262.         then print "in ->";record$ : goto skip.remarks\
  263.         else goto skip.remarks\
  264.     else gosub put.record
  265.  
  266.     return
  267.  
  268. check.left:
  269.  
  270.     rem First and only keyword on line
  271.  
  272.     if position% = 1\
  273.     then record$ = NEW.RECORD$(record$,position%,keyword$(i%)) : return
  274.  
  275.     rem Check for non-alpha character preceeding last keyword found in line
  276.  
  277.     if asc(mid$(record$,position% - 1,1)) < alpha.min%\
  278.     then record$ = NEW.RECORD$(record$,position%,keyword$(i%)) : return
  279.  
  280.     rem Imbedded keyword at end of record
  281.  
  282.     return
  283.  
  284. check.right:
  285.  
  286.     rem Continuation character after keyword OK
  287.  
  288.     if mid$(record$,position% + len(keyword$(i%)),1) = "\"\
  289.     then record$ = NEW.RECORD$(record$,position%,keyword$(i%)) : return
  290.  
  291.     rem Keyword imbedded in label so move forward in record
  292.  
  293.     if mid$(record$,position% + len(keyword$(i%)),1) = "."\
  294.     then start% = start% + position% : return
  295.  
  296.     rem Check for keyword with (, %, or $ at end
  297.  
  298.     if asc(mid$(record$,position% + len(keyword$(i%)) - 1,1)) < alpha.min%\
  299.     then record$ = NEW.RECORD$(record$,position%,keyword$(i%)) : return
  300.  
  301.     rem Check for non-alpha character following keyword
  302.  
  303.     if asc(mid$(record$,position% + len(keyword$(i%)),1)) < alpha.min%\
  304.     then record$ = NEW.RECORD$(record$,position%,keyword$(i%)) : return
  305.  
  306.     rem Must be imbedded keyword, so move forward in record
  307.  
  308.     start% = start% + position%
  309.  
  310.     return
  311.  
  312. get.record:
  313.  
  314.     quote.position% = 0
  315.     character% = 0
  316.  
  317.     rem Do until end of record marked by line feed
  318.  
  319.     while character% <> lf%
  320.     
  321.         record.position% = record.position% + 1
  322.  
  323.         character% = get(1)
  324.  
  325.         record$ = record$ + chr$(character%)
  326.  
  327.         rem If quotation mark, then mark it and return
  328.  
  329.         if character% = quote.mark%\
  330.         then quote.position% = record.position% : return
  331.  
  332.     wend
  333.  
  334.     rem Strip cr,lf from record
  335.  
  336.     if len(record$) > 0\
  337.     then record$ = left$(record$, len(record$) - 2)
  338.  
  339.     if view%\
  340.     then print "in ->";record$
  341.  
  342.     rem Flag the end of the record
  343.  
  344.     end.record% = true%
  345.  
  346.     return
  347.  
  348. put.record:
  349.  
  350.     rem Rebuild record and null remark.segement$
  351.  
  352.     record$ = record$ + remark.segment$
  353.  
  354.     if remark.segment$ <> ""\
  355.     then remark.segment$ = "" : gosub skip.remarks : return
  356.  
  357.     if view%\
  358.     then print "out->";record$
  359.  
  360.     if examine%\
  361.     then if inkey = ctrlc%\
  362.     then stop
  363.  
  364.     print using "&"; # 2; record$
  365.  
  366.     return
  367.  
  368. all.done:
  369.  
  370.     print: print "File processed."
  371.  
  372.     stop 
  373.  
  374. data    "unlock(", "unlocked", "wend", "while",  "xor", "fend", "abs(",\
  375.     "and", "as", "asc(", "atn(", "attach(", "buff", "call",\
  376.     "chain", "chr$", "close", "command$", "common", "conchar%", "console",\
  377.     "constat%", "cos(", "create", "data", "def", "delete", "detach",\
  378.     "dim", "else", "end", "error", "errl", "err", "eq",\
  379.     "exp(", "external", "float(", "for", "fre(", "get(", "ge",\
  380.     "goto", "gosub", "go", "gt", "if", "initialize", "inkey",\
  381.     "input", "inp(", "lprinter", "print", "int%", "integer", "len(",\
  382.     "left$", "let", "le", "line", "locked", "lock(", "log(",\
  383.     "lt", "match(", "mfre", "mid$", "mod(", "ne", "next",\
  384.     "not", "on", "open", "or", "out(", "peek(", "poke",\
  385.     "pos", "int%(", "int(", "public", "put", "randomize", "readonly",\
  386.     "read", "real", "recl", "recs", "remark", "rem", "rename(",\
  387.     "restore", "return", "right$", "rnd(", "sadd(", "sgn(", "shift(",\
  388.     "sin(", "size(", "sqr(", "step", "stop", "str$", "string$",\
  389.     "string", "sub", "tab(", "tan(", "then", "to", "ucase$",\
  390.     "using", "val(", "varptr(", "width", "%chain", %debug, "%eject",\
  391.     "%include", "%list", "%nolist", "%page"
  392.  
  393. end
  394.