home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / basic / pbs.lbr / PBS.BZS / PBS.BAS
Encoding:
BASIC Source File  |  1988-05-06  |  4.8 KB  |  151 lines
  1.  1 '@initialization
  2.  2 defint a-z
  3.  3 option base 1
  4.  4 on error goto  145 ' @ERRORTRAPS
  5.  5 '
  6.  6 '@integers
  7.  7 cp = 0 ' current position in scanning loops
  8.  8 lcount = 0 ' initial line counter
  9.  9 lnumber = 0 ' line number where labels are found
  10.  10 howmany = 0 ' how many labels counter
  11.  11 lpoint = 0 ' pointer for parsing labels in second pass
  12.  12 sofar = 0 ' length of line being built
  13.  13 '
  14.  14 '@strings
  15.  15 a$ = "" ' oft used
  16.  16 cc$ = "" ' current character in scanning loops
  17.  17 tb$ = chr$(9) ' tab
  18.  18 sp$ = chr$(32) ' space
  19.  19 qt$ = chr$(34) ' quote
  20.  20 rm$ = chr$(39) ' rem (apostrophe)
  21.  21 cm$ = chr$(44) ' comma
  22.  22 cl$ = chr$(58) ' colon
  23.  23 qm$ = chr$(63) ' question mark
  24.  24 lm$ = chr$(64) ' label marker
  25.  25 white$ = tb$ + sp$ ' characters which comprise white space
  26.  26 split$ = white$ + rm$ + cm$ + cl$ ' characters which may end a label
  27.  27 tail$ = "" ' remarks to follow parsed lines
  28.  28 clabel$ = "" ' current label string for parsing
  29.  29 '
  30.  30 '@arrays
  31.  31 dim label$(1000) ' string storage for labels
  32.  32 dim lnumber(1000) ' and the line numbers they mark
  33.  33 '
  34.  34 '@getspec
  35.  35 ' input f$ ' use this line under mbasic interpreter
  36.  36 call ctail(f$) ' use this line for compiled version
  37.  37 source$ = f$ + ".PBS"
  38.  38 output$ = f$ + ".BAS"
  39.  39 '
  40.  40 '@checkout
  41.  41 open "i", 1, output$
  42.  42 print "File " output$ " exists.  Replace (N/y)? ";
  43.  43 a$ = input$(1)
  44.  44 if instr("Yy",a$) <> 0 then print "Yes" : kill output$ : else print "No" : goto  112 ' @FINIT
  45.  45 '
  46.  46 '@okayout
  47.  47 close
  48.  48 '
  49.  49 '@checkin
  50.  50 open "i", 1, source$
  51.  51 '
  52.  52 '@pass1
  53.  53 print "First pass, searching for labels"
  54.  54 while not eof(1)
  55.  55 lcount = lcount + 1
  56.  56 line input #1, a$
  57.  57 gosub  131 ' @TRIMLEAD
  58.  58 if len(a$) = 0 then  66 ' @DONESCAN1
  59.  59 if left$(a$,1) <> lm$ then  66 ' @DONESCAN1
  60.  60 howmany = howmany + 1 ' if we're here, we've found a label
  61.  61 lnumber(howmany) = lcount ' on the current line
  62.  62 cp = 0
  63.  63 gosub  119 ' @FINDEND
  64.  64 label$(howmany) = clabel$ : clabel$ = ""
  65.  65 '
  66.  66 '@donescan1
  67.  67 wend
  68.  68 close
  69.  69 print "Found" howmany "labels in" lcount "lines"
  70.  70 lcount = 0 ' return this to initial value for next pass
  71.  71 '
  72.  72 '@pass2
  73.  73 print "Second pass, resolving labels
  74.  74 open "i", 1, source$
  75.  75 open "o", 2, output$
  76.  76 while not eof(1)
  77.  77 lcount = lcount + 1
  78.  78 line input #1, a$
  79.  79 gosub  131 ' @TRIMLEAD
  80.  80 gosub  138 ' @TRIMTAIL
  81.  81 tail$ = ""
  82.  82 if len(a$) = 0 then a$ = rm$ + a$ : goto  106 ' @DONESCAN2
  83.  83 if left$(a$,1) = lm$ then a$ = rm$ + a$ : goto  106 ' @DONESCAN2
  84.  84 '
  85.  85 '@parse
  86.  86 first$ = "" : clabel$ = "" : last$ = "" ' clear these first
  87.  87 if instr(a$,lm$) = 0 then  106 ' @DONESCAN2
  88.  88 first$ = left$(a$,instr(a$,lm$)-1) ' everything before the label mark
  89.  89 cp = len(first$)
  90.  90 gosub  119 ' @FINDEND
  91.  91 sofar = len(first$) + len(clabel$) ' how much of the line do we have?
  92.  92 last$ = right$(a$,len(a$)-sofar)
  93.  93 for cp = 1 to howmany
  94.  94 if label$(cp) <> clabel$ then  98 ' @REMAKE
  95.  95 tail$ = tail$ + sp$ + rm$ + sp$ + clabel$
  96.  96 clabel$ = str$(lnumber(cp))
  97.  97 '
  98.  98 '@remake
  99.  99 a$ = first$ + clabel$ + last$
  100.  100 next
  101.  101 if left$(clabel$,1) <> lm$ then  85 ' if label was found, continue ' @PARSE
  102.  102 tail$ = tail$ + sp$ + rm$ + qm$ + clabel$ ' note bad label in remark
  103.  103 mid$(a$,instr(a$,lm$)) = qm$ ' replace @ with ? in bad label
  104.  104 print " -> possible bad label:  " clabel$ " on line" lcount
  105.  105 '
  106.  106 '@donescan2
  107.  107 print#2, lcount; a$ ; tail$
  108.  108 a$ = ""  : tail$ = "" ' clear these last
  109.  109 wend
  110.  110 close
  111.  111 '
  112.  112 '@finit
  113.  113 print "Returning to system.";
  114.  114 end
  115.  115 end
  116.  116 '
  117.  117 '@subroutines
  118.  118 '
  119.  119 '@findend
  120.  120 cp = cp + 1
  121.  121 cc$ = mid$(a$,cp,1)
  122.  122 if instr(split$,cc$) > 0 then  127 ' @FOUNDEND
  123.  123 clabel$ = clabel$ + cc$
  124.  124 if cp <= len(a$) then  119 ' @FINDEND
  125.  125 cp = 0
  126.  126 '
  127.  127 '@foundend
  128.  128 call ucase(clabel$) ' disable this line if using interpreter
  129.  129 return
  130.  130 '
  131.  131 '@trimlead
  132.  132 if len(a$)=0 then  135 ' @NOLEAD
  133.  133 if instr(white$,left$(a$,1)) then a$ = right$(a$,len(a$)-1) : goto  131 ' @TRIMLEAD
  134.  134 '
  135.  135 '@nolead
  136.  136 return
  137.  137 '
  138.  138 '@trimtail
  139.  139 if len(a$)=0 then  142 ' @NOTAIL
  140.  140 if instr(white$,right$(a$,1)) then a$ = left$(a$,len(a$)-1) : goto  138 ' @TRIMTAIL
  141.  141 '
  142.  142 '@notail
  143.  143 return
  144.  144 '
  145.  145 '@errortraps
  146.  146 if err=53 and erl =  41 then resume  46 ' @CHECKOUT ' @OKAYOUT
  147.  147 if err=53 and erl =  50 then print "Can't find " source$ : resume  112 ' @CHECKIN ' @FINIT
  148.  148 if err=64 then print "Bad file name" : resume  112 ' @FINIT
  149.  149 print "Untrapped error" err "in line" erl : resume  112 ' @FINIT
  150.  150 end
  151.