// 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)&#377		//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