// BCPLALTO.bcpl - BCPL Alto-specific functions
// Copyright Xerox Corporation 1980
// Swinehart, 6 May 77, File lengths -> statics
// Edit by Boggs to increase size of source file name 1 Apr 77
// Edits by Sproull to convert to new OS September 7, 1976
// InitBCPL calls Main<SWINEHART>BCPLALTO.;9 4-APR-75 07:54:29 EDIT BY SWINEHART
// pull SWAltoc...ime <SWINEHART>BCPLALTO.;8 28-MAR-75 13:24:11 EDIT BY SWINEHART
// <SWINEHART>BCPLALTO.;5 21-MAR-75 11:44:33 EDIT BY SWINEHART
// last modified by Butterfield, March 10, 1980 4:39 PM
// - InitBCPL, print date of March 10, 1980 - 3/10
// - RestartBCPL, add CounterJunta and add RestartAfterCounterJunta - 1/8
// - convert to OS 17: get bcplfiles.d and remove noLog - 1/7/80
// - incorporate Paxton's GetFileMax increase from 25 to 50 - 5/8
// - add RestartBCPL - 5/5
// - InitBCPL, change date - 5/4
// - ReadCOMCM, add argument and result; and add CloseCOMCM - 5/4
// - ReadCOMCM, add minus switches - 2/2/79
get "bcplx"
get "bcpliox"
get "streams.d"
get "altofilesys.d"
get "sysdefs.d"
get "bcplfiles.d"
//Outgoing procedures
external
[
openfile
InitToRead
]
// Incoming OS procedures
external [
OpenFile
Closes
Gets
Puts
FilePos
SetFilePos
Resets
Endofs
TruncateDiskStream
WriteBlock
ReadBlock
Ws
CallSwat
GetCurrentFa
JumpToFa
MoveBlock
keys
dsp
fpComCm
]
manifest [
zframemax = #335
zframenext = #336
zframefirst = #337
waitdefault=5
]
static [ cstream = 0 ] // used by ReadCOMCM and CloseCOMCM
static [ BcplRunCfa; BcplOverlayCnt; BcplParamVec ]
// The first 4 words of parameter vector are used for PC's
// named A,B,C,D -- see loadbcpl.cm. The next lFP*3 are
// used for FP's for the three temporary files (Bcpl.Scratch*)
manifest FPParamOffset=4
let InitBCPL(paramvec,nil,cfa) be
[
TTOstream = -1
TTIstream = -1
Ostream = -1; Istream = -1;
Version = (2 lshift 8) + 2
SWAlto = true // default -- compile ALTO code
WriteS("Alto BCPL of March 10, 1980*N")
DictFreeLimit = paramvec!1-1
TreeFreeLimit = paramvec!2-1
CodeFreeLimit = paramvec!3-1
FreeMax = DictFreeLimit
FileNameLength = 40 // *DCS...
GetFileMax = 50
// Save CFA, and remember that it denotes overlay 0
BcplOverlayCnt=0
BcplRunCfa=cfa
BcplParamVec=paramvec
// CALL THE COMPILER
Main(paramvec)
]
and RestartBCPL(deletePos, copyPos) be
[
let s = openNlog("COM.CM", ksTypeReadWrite, fpComCm);
let delete = copyPos - deletePos;
let p = copyPos;
[
SetFilePos(s, 0, p); if Endofs(s) then break; let c = Gets(s);
SetFilePos(s, 0, p - delete); Puts(s, c);
p = p + 1;
] repeat
SetFilePos(s, 0, p - delete); TruncateDiskStream(s); Closes(s);
CounterJunta(RestartAfterCounterJunta)
]
and RestartAfterCounterJunta() be
[
let s = openNlog(0, ksTypeReadOnly, lv BcplRunCfa>>CFA.fp);
CallSubsys(s, 0, 0, BcplParamVec);
]
and InitToRead(x) be
[
return
]
and syscall(call, ac) = valof
[
CallSwat("Unexpected SYSCALL")
]
and Readch(stream, lvc) be
[
rv lvc = stream eq -1?
Gets(keys),
(Endofs(stream) ? #777, Gets(stream) )
]
and Writech(stream, c) be
[
if stream eq -1 then stream=dsp
Puts(stream, c)
]
and WW(ch) be
[
static [ newlinecount = 0 ]
let newline = ch eq $*n
test newline
ifnot newlinecount = 0
ifso [ if newlinecount ge 2 return
newlinecount = newlinecount + 1
]
if SWOneCase do
if $a le ch & ch le $z do ch = ch + ($A-$a)
test Ostream eq -1
then
[ Puts(dsp, ch)
if newline & SWWait do Wait()
]
or
[ Puts(Ostream, ch )
if newline do
[ static [ lastformfeed = 0 ]
if Position(Ostream) gr lastformfeed+#20000 do
[ lastformfeed = Position(Ostream); WW(#14) ]
]
]
]
and Wait() be
[
static [ waitcount = waitdefault ]
waitcount = waitcount - 1
if waitcount ne 0 return
waitcount=waitdefault
Ws("Type any character to proceed:")
Gets(keys)
]
and Readword(stream, lvw) be
[
rv lvw = ( Gets(stream) lshift 8 ) + Gets(stream)
]
// different from Readword in DOS
and ReadWord(stream) = valof
[
let w = nil
Readword(stream, lv w)
resultis w
]
and Readaddr(stream, lva) be
[ Readaddr = Readword
Readword(stream, lva)
]
and Writeword(stream, w) be
[
Puts(stream, w rshift 8)
Puts(stream, w ) // OS will mask low 8 bits
]
// different from Writeword in DOS
and WriteWord(stream, w) be Writeword(stream,w)
and Writeaddr(stream, a) be
[ Writeaddr = Writeword
Writeword(stream, a)
]
and dospointer(bcplname, dosname) be
CallSwat("dospointer unexpectedly called")
and ReadSequential(stream,wd,ct) be
[
// must start on core, memory word boundaries
// ct must be even if subsequent calls are to work
ReadBlock(stream, wd, ct)
]
and WriteSequential(stream,wd,ct) be
[
// must start on core, memory word boundaries
// ct must be even if subsequent calls are to work
WriteBlock(stream, wd, ct)
]
and openfile(name, typ; numargs n) = valof
[ if name eq 0 resultis -1
if name!0 eq 0 resultis -1
if n eq 1 then typ=ksTypeReadWrite
let r = OpenFile(name, typ, 1, ((typ eq ksTypeReadOnly)? verLatest, verLatestCreate))
if r eq 0 then [ Ws("Can't open file:"); Error(name) ]
resultis r
]
and OpenInput(name) = openfile(name, ksTypeReadOnly)
and OpenOutput(name) = openfile(name, ksTypeWriteOnly)
and closechannel(chnl) be Closes(chnl)
and Position(chnl) = FilePos(chnl)
and Reposition(channel, pos) be SetFilePos(channel, 0, pos)
and ResetStream(channel) be Resets(channel)
and IsFile(name) = valof
[
let s = OpenFile(name, ksTypeReadOnly); if s eq 0 then resultis false
Closes(s); resultis true
]
//Open a file possible from FP, and no logging....
and openNlog(nm, typ, fp) = valof
[
let s=OpenFile(nm, typ, 1, 0, fp)
if s eq 0 then CallSwat("Cannot open vital file", nm)
resultis s
]
and OpenTemp(ch) = valof
[
let name = FileNameLength/2; Dvec(OpenTemp,lv name)
Unpackstring("Bcpl.Scratch0", filename)
filename!(filename!0) = ch
FixFileName(name, "", "")
// Speed up opening these files:
compileif lFP*3+FPParamOffset gr 25 then [ foo=nil ]
let fromFp=BcplParamVec+ (selecton ch into
[
case $l: FPParamOffset
case $d: FPParamOffset+lFP
case $c: FPParamOffset+lFP*2
default: CallSwat("temp")
] )
let fp=vec lFP
MoveBlock(fp, fromFp, lFP)
let s=openNlog(name,ksTypeReadWrite,fp)
for i=0 to lFP-1 do if fp!i ne fromFp!i then
[
MoveBlock(fromFp, fp, lFP)
let t=openNlog(0, ksTypeReadWrite, lv BcplRunCfa>>CFA.fp)
SetFilePos(t, 0, (offset SV.BLV/16)*2)
WriteBlock(t, BcplParamVec, (size BLV.overlayAddress/16))
Closes(t)
break
]
resultis s
]
and Overlay(name) be
[
let h = vec 16
Unpackstring(name, h) //Find out which one
let c=h!(h!0)
let ovNum=selecton c into
[
case $L: 1
case $C: 2
case $S: 3
case $T: 4
case $G: 5
default: CallSwat("Bad overlay name")
]
let s = openNlog(0, ksTypeReadOnly, lv BcplRunCfa>>CFA.fp)
JumpToFa(s, lv BcplRunCfa>>CFA.fa)
[
ReadBlock(s, h, 16)
ReadBlock(s, h!0, h!1)
let extra=(h!4)Ź //More to read to finish page
if extra then
for i=extra*2 to 511 do unless Endofs(s) then Gets(s)
GetCurrentFa(s, lv BcplRunCfa>>CFA.fa)
BcplOverlayCnt=BcplOverlayCnt+1
] repeatuntil BcplOverlayCnt eq ovNum
Closes(s)
]
and Help(Message) be
[
WriteS(Message)
CallSwat("Help called",Message)
]
and CloseCOMCM() be [ CloseInput(cstream); cstream = 0; ]
and ReadCOMCM(filepos; numargs na) = valof
[ //read the next name and switch list from COM.CM
if cstream eq 0 do cstream=openNlog("COM.CM", ksTypeReadOnly, fpComCm)
if na ge 1 then SetFilePos(cstream, 0, filepos)
filepos = FilePos(cstream)
filename!0, sw!0 = 0,0
let noswitches, notoken, i = true,true,1
[toke
Readch(cstream, lv filename!i)
switchon filename!i into
[
case $*S: if notoken then loop; break //may begin with blanks
case $*N: unless notoken do break //otherwise fall thru and
i = 1 //force it to look like the beginning
case #777:
if i eq 1 then [ //endof com.cm; beginning of line
CloseInput(cstream)
cstream = 0
filename!0 = -1
resultis filepos ]
break
case $/: noswitches = false; break
default:
if i gr FileNameLength do Error("file name too long")
i = i + 1; notoken = false
]
]toke repeat
filename!0 = i - 1
if noswitches then resultis filepos
let j, c = 1, nil; notoken = true; let minus = false;
[swloop
Readch(cstream, lv c)
if c ge $a & c le $z then c=c-$a+$A
switchon c into
[swcases
case $*S: if notoken then loop // or fall through to break
case $*N: case #377: break
case $/: loop
case $-: minus = true; loop
case $A to $Z: notoken = false
sw!j = (minus? -c, c); j = j + 1; minus = false;
]swcases
]swloop repeat
sw!0 = j - 1
resultis filepos
]
and InitFree(codetop) be
[ //external[ FreeBottom] // Reset free space bottom and zframemax
FreelistP = codetop + 1
rv zframemax = codetop + 1 ]
and Newvec(n) = valof
[nv
//external[ MaxTop ]
manifest[ stackoffset = 4 ]
let oldv, newv = FreelistP, FreelistP +n + 1
if ( newv < 0 ? true, // if newv in upper memory, all is lost
((lv n)-stackoffset < 0 ? false, // if stack still in upper
// memory, all is well
(newv gr ( lv n - stackoffset ) ))) // else, normal test
then [
rv zframemax = rv zframemax - #1000
Error("Out of Free Storage: Program too Big")
]
FreelistP = newv; rv zframemax = FreelistP
resultis oldv
]nv