CP/M/CPM_CDROM.iso/cpm/basic/pbs.lbr/PBS.PZS/PBS.PBS

Text File | 1988-05-06 | 4KB | 151 lines

@initialization
defint a-z
option base 1
on error goto @errortraps

@integers
cp = 0 ' current position in scanning loops
lcount = 0 ' initial line counter
lnumber = 0 ' line number where labels are found
howmany = 0 ' how many labels counter
lpoint = 0 ' pointer for parsing labels in second pass
sofar = 0 ' length of line being built

@strings
a$ = "" ' oft used
cc$ = "" ' current character in scanning loops
tb$ = chr$(9) ' tab
sp$ = chr$(32) ' space
qt$ = chr$(34) ' quote
rm$ = chr$(39) ' rem (apostrophe)
cm$ = chr$(44) ' comma
cl$ = chr$(58) ' colon
qm$ = chr$(63) ' question mark
lm$ = chr$(64) ' label marker
white$ = tb$ + sp$ ' characters which comprise white space
split$ = white$ + rm$ + cm$ + cl$ ' characters which may end a label
tail$ = "" ' remarks to follow parsed lines
clabel$ = "" ' current label string for parsing

@arrays
dim label$(1000) ' string storage for labels
dim lnumber(1000) ' and the line numbers they mark

@getspec
' input f$ ' use this line under mbasic interpreter
call ctail(f$) ' use this line for compiled version
source$ = f$ + ".PBS"
output$ = f$ + ".BAS"

@checkout
open "i", 1, output$
print "File " output$ " exists.  Replace (N/y)? ";
a$ = input$(1)
if instr("Yy",a$) <> 0 then print "Yes" : kill output$ : else print "No" : goto @finit

@okayout
close

@checkin
open "i", 1, source$

@pass1
print "First pass, searching for labels"
while not eof(1)
lcount = lcount + 1
line input #1, a$
gosub @trimlead
if len(a$) = 0 then @donescan1
if left$(a$,1) <> lm$ then @donescan1
howmany = howmany + 1 ' if we're here, we've found a label
lnumber(howmany) = lcount ' on the current line
cp = 0
gosub @findend
label$(howmany) = clabel$ : clabel$ = ""

@donescan1
wend
close
print "Found" howmany "labels in" lcount "lines"
lcount = 0 ' return this to initial value for next pass

@pass2
print "Second pass, resolving labels
open "i", 1, source$
open "o", 2, output$
while not eof(1)
lcount = lcount + 1
line input #1, a$
gosub @trimlead
gosub @trimtail
tail$ = ""
if len(a$) = 0 then a$ = rm$ + a$ : goto @donescan2
if left$(a$,1) = lm$ then a$ = rm$ + a$ : goto @donescan2

@parse
first$ = "" : clabel$ = "" : last$ = "" ' clear these first
if instr(a$,lm$) = 0 then @donescan2
first$ = left$(a$,instr(a$,lm$)-1) ' everything before the label mark
cp = len(first$)
gosub @findend
sofar = len(first$) + len(clabel$) ' how much of the line do we have?
last$ = right$(a$,len(a$)-sofar)
for cp = 1 to howmany
if label$(cp) <> clabel$ then @remake
tail$ = tail$ + sp$ + rm$ + sp$ + clabel$
clabel$ = str$(lnumber(cp))

@remake
a$ = first$ + clabel$ + last$
next
if left$(clabel$,1) <> lm$ then @parse ' if label was found, continue
tail$ = tail$ + sp$ + rm$ + qm$ + clabel$ ' note bad label in remark
mid$(a$,instr(a$,lm$)) = qm$ ' replace @ with ? in bad label
print " -> possible bad label:  " clabel$ " on line" lcount

@donescan2
print#2, lcount; a$ ; tail$
a$ = ""  : tail$ = "" ' clear these last
wend
close

@finit
print "Returning to system.";
end
end

@subroutines

@findend
cp = cp + 1
cc$ = mid$(a$,cp,1)
if instr(split$,cc$) > 0 then @foundend
clabel$ = clabel$ + cc$
if cp <= len(a$) then @findend
cp = 0

@foundend
call ucase(clabel$) ' disable this line if using interpreter
return

@trimlead
if len(a$)=0 then @nolead
if instr(white$,left$(a$,1)) then a$ = right$(a$,len(a$)-1) : goto @trimlead

@nolead
return

@trimtail
if len(a$)=0 then @notail
if instr(white$,right$(a$,1)) then a$ = left$(a$,len(a$)-1) : goto @trimtail

@notail
return

@errortraps
if err=53 and erl-1 = @checkout then resume @okayout
if err=53 and erl-1 = @checkin then print "Can't find " source$ : resume @finit
if err=64 then print "Bad file name" : resume @finit
print "Untrapped error" err "in line" erl : resume @finit
end