// S C A N (PREPRESS)
//BCPL.Run/f Scan.bcpl
//Last modified February 28, 1980 12:48 PM (by LaPrade)
// TypeForm now types carriage return without line feed.
// Reverted to old definition (groan) of StrCop.
//
//Last modified January 12, 1980 3:35 PM by Kerry A. LaPrade, XEOS
// TypeForm handles chars in range 0-#377.
//
//Modified November 8, 1979 12:09 PM (by LaPrade)
// ScanInit(b,file) (b= vec SCANIlen). Sets up a scan
// control block, using specified file to read from.
// ScanClose() Closes current file.
// ScanSet(b) (b = vec SCANIlen) use this file for scanner.
// b is set up with ScanInit
// Returns old pointer, if any, so you may restore.
// Scan() => token identifier (numbers defined in scan.defs)
// ScanFor(token) scans to be sure next thing is "token"
// ScanUntil(token) scans until token detected
// (if token=RPAREN, must be at this "level")
// ScanBack(token) arranges to have next token be token
// ScanGiveID() returns pointer to string last scanned as ID.
// ScanCh() returns a single character from the file.
// ReadNumber(STR) parses a number in STR format
// result in FPAC 1; integer part is result of fcn
// PrintNumber(STR,num [,radix])
// PrintFloat(str,lvnum) Prints floating point number.
// AppendChar(char, string) Appends char to string
// SearchChar(string, char) true if char appears in string
// StrEq(a,b) => true if two strings equal
// StrCop(f,t) copy STR f to STR t
// StringToValue(string, radix [10]) resultis (unsigned) value
// Type(STR) type string on terminal
// TypeIn(STR) get a string from the terminal, terminated by CR
// TypeForm(xxxxx)
// Types a formatted message. For each entry in the call,
// If it is not in the range 0-#377, type it as a string ptr.
// Otherwise if it is:
// 0 -- type carriage-return
// 1 -- use the next entry as a string pointer to accept typein
// 2 -- print the next entry as a floating point number
// 3 -- Double precision (fixed,fraction)
// 4 -- Double integer
// 8,10 -- print the next entry as a number in corresonding
// radix
// default -- print it as a single character.
// ReadCom(str,sw) =res
// Reads command file and returns true if more
// there. STR will contain string; sw if present
// is a list of switches (sw!0= # of sw's)
// ReadComInit() starts it off
get "GoodFoo.d"
get "scan.dfs"
//get "streams.d"
// outgoing procedures
external
[
AppendChar
PauseForCR
PrintFloat
PrintNumber
ReadComInit
ReadCom
ReadNumber
Scan
ScanFor
ScanUntil
ScanInit
ScanClose
ScanSet
ScanBack
ScanGiveID
ScanCh
SearchChar
StrCop
StrEq
StringToValue
Type
TypeForm
// TypeIn
]
// outgoing statics
external
[
@outstream //If non-zero, use for typing.
@ScanSavedLetter
]
static
[
@outstream
@ScanSavedLetter
]
// incoming procedures
external
[
Scream //This is for reporting errors
//OS
// Gets
// Puts
// Endofs
// OpenFile
// Closes
// Wss
// Zero
//FLOAT
FLD;FST;FTR;FLDI;FNEG;FAD;FSB;FML;FDV;FCM;FSN
FLDV;FSTV;FLDDP;FSTDP;DPAD;DPSB
//SDialog
// DlgInit
// DlgStr
//StringUtil
CopyString
StringCompare
]
// incoming statics
external
[
fpComCm
// keys
// dsp
]
// internal statics
static
[
@coms
@sc
]
// File-wide structure and manifest declarations.
//structure STR: [
// length byte
// char↑1,255 byte
//]
manifest
[
strlen = 10 //number of words
DEL = #177
CONTROLA = 1
BACKSPACE = $H - $A + 1
]
// Procedures
//Scanner routines.
//*********************************************************
let ScanInit(b,s) be
//*********************************************************
[
Zero(b, SCANIlen)
let str = OpenFile(s, ksTypeReadOnly, 1)
if str eq 0 then Scream("File not found")
b>> SCANI.stream = str
]
//*********************************************************
and ScanClose() be Closes(sc>>SCANI.stream)
//*********************************************************
//*********************************************************
and Scan() = valof
//*********************************************************
[
let ins = sc>> SCANI.stream
let lastch = sc>> SCANI.lastch
let ch = sc>> SCANI.backtoken
if ch ne 0 then
[
sc>> SCANI.backtoken=0
resultis ch
]
test lastch eq 0
ifso ch = Gets(ins)
ifnot ch = lastch
let idname=lv sc>>SCANI.idname
sc>>SCANI.lastch = 0
[
if Endofs(ins) then resultis EOF
let c = getcharclass(ch)
switchon c into
[
case 0: //separator...
endcase
case 1: // left parenthesis.
if Endofs(ins) then resultis LPAREN
ch = Gets(ins)
if getcharclass(ch) eq 2 then resultis SNIL
sc>> SCANI.lastch = ch
resultis LPAREN
case 2:
resultis RPAREN
case 3: // "
[
let cn = 0
[
if Endofs(ins) then break
ch = Gets(ins)
if getcharclass(ch) eq 3 then break
cn = cn + 1
idname>> STRING.char↑cn = ch
] repeat
idname>> STRING.length = cn
]
resultis STRING
case 4:
resultis SLASH
case 5:
case 6: //Scan into an identifier.
[
let firstclass = c
let cn = 0
[
ScanSavedLetter=ch
if $a le ch & ch le $z then ch = ch - $a + $A
cn = cn + 1
idname>> STRING.char↑cn=ch
if Endofs(ins) then break
ch = Gets(ins)
let c = getcharclass(ch)
if c ls 5 then break //out of bounds.
] repeat
idname>> STRING.length = cn
sc>>SCANI.lastch = ch
let failflg = true //try number, but may not be one
if firstclass eq 5 then ReadNumber(idname, 1, lv failflg)
resultis (failflg ? ID, NUMBER)
]
case 7:
resultis EQUAL
]
ch = Gets(ins)
] repeat
]
//*********************************************************
and ScanFor(token) be
//*********************************************************
[
let c = Scan()
if c ne token then Scream("Format")
]
//*********************************************************
and ScanUntil(token) be
//*********************************************************
[
let level = 0
[
let c=Scan()
if c eq token then
if token ne RPAREN % level eq 0 then return
if c eq LPAREN then level=level+1
if c eq RPAREN then level=level-1
] repeat
]
//*********************************************************
and ScanBack(token) be sc>>SCANI.backtoken = token
//*********************************************************
//*********************************************************
and ScanSet(b) = valof
//*********************************************************
[
let c = sc
sc = b
resultis c
]
//*********************************************************
and ScanGiveID() = lv sc>>SCANI.idname
//*********************************************************
//*********************************************************
and ScanCh() = valof
//*********************************************************
[
let ch=sc>>SCANI.lastch
sc>>SCANI.lastch=0
if ch then resultis ch
let ins=sc>>SCANI.stream
if Endofs(ins) then resultis EOF
ch=Gets(ins)
resultis ch
]
//*********************************************************
and getcharclass(ch) =
//*********************************************************
selecton ch into
[
case $*s:
case $*l:
case $*n:
case #11:
0
case $(:
1
case $):
2
case $":
3
case $/:
4
case $-:
case $.:
case $0:
case $1:
case $2:
case $3:
case $4:
case $5:
case $6:
case $7:
case $8:
case $9:
5
case $=:
7
default:
6
]
//Number reading and printing....
//*********************************************************
and ReadNumber (str,x,fail;numargs na) = valof
//*********************************************************
// Read a number from str and return it in FPAC 1
// uses FPAC's 2,3,4
// Set @fail if it turns out not to be a number.
//
[
let a = nil
DefaultArgs(lv na, 1, 1, lv a)
// if na eq 1 then x = 1
// if na ls 3 then fail = lv a
@fail=false
let octn=0
let sign=false
FLDI(1,0); FLDI(4,10); FLDI(2,1)
let pseen=false
for i = x to str>> STRING.length do
[
let ch=str>> STRING.char↑i
test ch eq $.
ifso pseen = true
ifnot
[
test ch eq $-
ifso sign=not sign
ifnot
[
test $0 le ch & ch le $9
ifso
[
FLDI(3,ch-$0)
test pseen
ifso [ FDV(2,4); FML(3,2) ]
ifnot FML(1,4)
FAD(1,3)
octn=(octn lshift 3)+ch-$0
]
ifnot
[
test ch eq $E
ifso
[ //exponent...
let flg=nil
let s=vec 2; FST(1,s);
ReadNumber(str,i+1,lv flg)
if flg then [ @fail=true; break ]
let exp=FTR(1)
FLD(1,s)
FLDI(4,10)
while exp gr 0 do [ FML(1,4); exp=exp-1 ]
while exp ls 0 do [ FDV(1,4); exp=exp+1 ]
break
]
ifnot
[
test ch eq $Q
ifso FLDI(1,octn)
ifnot
[
@fail=true
break //Don't try to parse any more
]
]
]
]
]
]
if @fail ne 0 & na ls 3 then Scream("ReadNumber: format")
if sign then FNEG(1)
resultis(FTR(1))
]
//*********************************************************
and PrintNumber(str, n, radix, pos; numargs na) be
//*********************************************************
[
// DefaultArgs(lv na, 2, 10, 0)
if na ls 4 then str>> STRING.length = 0
if na ls 3 then radix = 10
if n ls 0 then
[
n = -n
AppendChar($-, str)
]
printnumber2(str, n, radix)
]
//*********************************************************
and printnumber2(str, n, radix) be
//*********************************************************
[
let f = n / radix
if f ne 0 then printnumber2(str, f, radix)
AppendChar($0 + (n rem radix), str)
]
//*********************************************************
and PrintFloat(s, lvnum) be
//*********************************************************
[
let v = vec 4*5
for i = 1 to 4 do FSTV(i, v + 4 * i)
@s = 0
FLD(1,lvnum)
let p = FSN(1)
test p eq 0
ifso
AppendChar($0, s)
ifnot
[ //Really work
if p eq -1 then [ FNEG(1); AppendChar($-, s) ]
FLDV(2, table [ 0; 1; #100000; 4 ]) //Fuzz1= 1 + 2E-9
FML(1, 2) //n←fuzz1*number
FLDI(3, 1);FLDI(2,10)
FLD(4, 1) //number
p = 0
while FCM(4, 2) eq 1 do [ FDV(4, 2); p = p + 1 ]
while FCM(4, 3) eq -1 do [ FML(4, 2); p = p - 1 ]
// 4 has number between 1 and 10, and p has power
FLD(3, table [ #031325; #163073 ]) //Fuzz2 = 5E-9
FML(3, 1) //s←fuzz2 * n
let q = p
test p gr 7 % p ls -3 then p = 0 or q = 0
test p ls 0
ifso
[
AppendChar($0, s); AppendChar($., s)
for i = p to -2 do AppendChar($0, s)
for i = 1 to -p do FDV(3, 2) //s = s E P
]
ifnot
for i = 1 to p do FML(3,2)
//now print (s suppresses trailing zeroes)
for i = 1 to 9 do
[
let ipart = FTR(4)
AppendChar($0 + ipart, s)
p = p - 1
FLDI(1,ipart); FSB(4, 1); FML(4, 2)
if p ls 0 then
[
if p eq -1 then AppendChar($., s)
FML(3, 2)
if FCM(4, 3) eq -1 then break //fuzz
]
]
if q ne 0 then
[
AppendChar($E, s);
PrintNumber(s,q,10,nil)
]
] //Really work
for i = 1 to 4 do FLDV(i,v+4*i)
]
//Type in and out routines.
//*********************************************************
and TypeForm(m,nil,nil,nil,nil,nil,nil,nil,nil,nil,nil,nil; numargs na) be
//*********************************************************
[
let lvm = lv m
let i = 0; let str = vec 20
while i ls na do
[
let x = lvm!i
let i1 = i + 1
if (x & #177400) eq 0 then switchon x into
[
case 8:
case 10:
i = i1
PrintNumber(str,lvm!i,x)
x = str
endcase
case 0:
// x = "*N*L"
x = "*N"
endcase
case 1:
i = i1
TypeIn(lvm!i)
x = ""
endcase
case 2:
i = i1
PrintFloat(str, lvm!i)
x = str
endcase
case 3:
case 4:
[
i = i1
let v = vec 4
FSTV(1, v)
FLDDP(1, lvm!i)
if x eq 4 then
[
let s = vec 4
FSTV(1, s); s!1 = s!1 + 16; FLDV(1, s)
]
PrintFloat(str,1)
FLDV(1, v)
x = str
]
endcase
default:
str!0 = x + #400
x = str
endcase
]
Type(x)
i = i + 1
]
]
//*********************************************************
and Type(str) be
//*********************************************************
Wss(((outstream eq 0)? dsp, outstream), str)
//*********************************************************
and TypeIn(str) be
//*********************************************************
[
// DlgInit()
// DlgStr("", str)
//The following code is evidently an alternative to the SDialog
//package
let count=0
let ch = Gets(keys)
until ch eq $*N do
[
switchon ch into
[
case BACKSPACE:
case CONTROLA:
if count eq 0 then endcase
Puts(dsp,$/)
Puts(dsp,str>> STRING.char↑count)
count = count - 1
endcase
case DEL:
Type("XXX");count=0
endcase
default:
count = count + 1
str>> STRING.char↑count = ch
Puts(dsp,ch)
endcase
] //end of switchon
ch = Gets(keys)
] //end of wait for *n
str>> STRING.length=count
Puts(dsp,$*n)
]
//String stuff
//*********************************************************
//and AppendChar(string, char) be
and AppendChar(char, string) be
//*********************************************************
[
let newLength = string>> STRING.length + 1
string>> STRING.char↑newLength = char
string>> STRING.length = newLength
]
//*********************************************************
and SearchChar(string, char) = valof
//*********************************************************
[
for I = 1 to string>> STRING.length do
if string>> STRING.char↑I eq char then resultis true
resultis false
]
//*********************************************************
and StrEq(a,b) = StringCompare(a, b) eq 0
//*********************************************************
// [
// if a>> STRING.length ne b>> STRING.length then resultis false
// for i = 1 to a>> STRING.length do
// [
// let c1=a>> STRING.char↑let c2=b>> STRING.char↑i
// if (c1 ge $a)&(c1 le $z) then c1=c1+$A-$a
// if (c2 ge $a)&(c2 le $z) then c2=c2+$A-$a
// unless c1 eq c2 then resultis false
// ]
// resultis true
// ]
//*********************************************************
and StrCop(source, destination) be
//*********************************************************
[
for i = 1 to source>> STRING.length do
destination>> STRING.char↑i = source>> STRING.char↑i
destination>> STRING.length = source>> STRING.length
]
////*********************************************************
//and StrCop(source, destination) be
////*********************************************************
//Commented out because CopyString does a move block,
// which sometimes puts garbage into
// destination>> STRING.char↑(source>> STRING.length + 1)
//
// CopyString(destination, source)
//Command line reader and processor. Uses the main routine SCAN above.
//************************************************
and StringToValue(string, radix; numargs na) = valof
//************************************************
[
DefaultArgs(lv na, 0, "", 10)
let N = 0
for I = 1 to string>> STRING.length do
N = N * radix + (string>> STRING.char↑I - $0)
resultis N
]
//*********************************************************
and ReadComInit() be
//*********************************************************
[
coms=table [ 0;0;0;0;0;0;0;0;0;0;0;0;0;0 ]
compileif SCANIlen gr 14 then [ foo = nil ]
Zero(coms, SCANIlen)
coms>>SCANI.stream =
OpenFile("Com.Cm", ksTypeReadOnly, 1, 0, fpComCm)
]
//*********************************************************
and ReadCom(str,sw; numargs na) = valof
//*********************************************************
[
if na eq 2 then sw!0 = 0
let old = ScanSet(coms)
let ans = valof
[
let c = Scan()
if c eq EOF then [ ScanBack(EOF); resultis 0 ]
if c eq ID % c eq NUMBER then
[
StrCop(lv coms>> SCANI.idname,str)
while coms>> SCANI.lastch eq $/ do
[ //switches
Scan() //To pick up /
Scan()
if na eq 2 then
[
let s = (lv coms>>SCANI.idname)
for i = 1 to s>> STRING.length do
[
sw!0 = sw!0+1
sw!(sw!0) = s>> STRING.char↑i
]
]
]
resultis c
]
Scream("Invalid command line")
]
ScanSet(old)
resultis ans
]
//************************************************
and PauseForCR(string) be
//************************************************
[
Wl(" Pause for CR")
Ws(string)
let char = nil
[
char = Gets(keys)
]
repeatuntil char eq $*n % char eq $b % char eq $B
unless char eq $*n do CallSwat()
]