// StampVersions.bcpl. Puts version numbers into .eb files.
// Created December 21, 1982 4:43 PM by Bill van Melle

get "AltoFileSys.d"
get "Streams.d"

external [// O.S. procedures
Resets; Closes; CreateDiskStream; OpenFile
Endofs; Gets; Puts; SetFilePos; Wss
CallSwat

// OS statics
fpComCm; fpRemCm
]

static[
dontGiveUp = false
]

manifest [
LispVersionStart = #200
]

structure String: [ length byte; char↑1,255 byte ]


let StampVersions() be
[
// Read command line: format is
// StampVersions <filename> <RamVersion> <MinBcplForRam> <MinLispForRam>

let name = vec 80
let comFile = CreateDiskStream(fpComCm, ksTypeReadOnly, charItem)
ReadToken(comFile, name)// skip over "StampVersions.run "
ReadToken(comFile, name)
let ebFile = OpenFile(name, ksTypeReadWrite, wordItem)
if ebFile eq 0
then GiveUp (name, " -- file not found")
let RamVersion = ReadNumber(comFile)
let MinBcplForRam = ReadNumber(comFile)
let MinLispForRam = ReadNumber(comFile)
Closes(comFile)
SetFilePos(ebFile, 0, LispVersionStart)
Puts(ebFile, RamVersion)
Puts(ebFile, MinBcplForRam)
Puts(ebFile, MinLispForRam)
Closes(ebFile)
finish
]

and ReadToken(st, body) = valof
[
let bodylen = 0
[// begin loop
let ch = Endofs(st)? $*N, Gets(st)
switchon ch into
[
case $*S: case $*N:// end of token
if bodylen gr 0
then [ body>>String.length = bodylen
resultis body
]
if Endofs(st)
then GiveUp ("Premature end of command line")
endcase
default:
bodylen = bodylen+1
body>>String.char↑bodylen = ch
]
] repeat

]

and ReadNumber(st) = valof
[
let charfound = false
let result = 0
[// begin loop
let ch = Endofs(st)? $*N, Gets(st)
switchon ch into
[
case $*S: case $*N:// end of token
if charfound
then resultis result
if Endofs(st)
then GiveUp ("Premature end of command line")
endcase
default:
if (ch ls $0) % (ch gr $7)
then [
let str = vec 2
str>>String.length = 1
str>>String.char↑1 = ch
GiveUp("Invalid character in octal constant: ",
str)
]
charfound = true
result = (result lshift 3) + (ch - $0)
]
] repeat

]

and GiveUp(str1, str2; numargs na) be
[
let st = dontGiveUp? 0, CreateDiskStream(fpRemCm, ksTypeWriteOnly, charItem)
test st
ifso [ Resets(st)
Wss(st, "// ")// write str on rem.cm for cleaner crash
Wss(st, str1)
if (na gr 1) & str2 & (str2!0)
then Wss(st, str2)
Wss(st, "*N")
Closes(st)
finish
]
ifnot CallSwat (str1, str2)
]