// 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)
   ](1792)