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