// BCPLDOS.bcpl - BCPL DOS-specific functions
// Copyright Xerox Corporation 1980
// Swinehart, 6 May 77, file lengths -> statics
// InitBCPL calls Main<SWINEHART>BCPLDOS.;5     4-APR-75 07:56:19    EDIT BY SWINEHART
// pull SWAltoc...ime <SWINEHART>BCPLDOS.;3    28-MAR-75 13:22:29    EDIT BY SWINEHART


get "bcplx"
get "bcpliox"

external[ 
bufferio
displaystream
ReadchKLUDGE
streamvec
syscall
WritechKLUDGE
InitToRead
openfile
]

manifest [
	zframemax = #335
	zframenext = #336
	zframefirst = #337
	zreturn = #366
	    ]

// system-dependent manifests, used by InitBCPL

manifest
   [
   STREAMsize = ((size STREAM + 15)/16)
   streamvecsize = 7
   ]
structure [ blank bit 15; ODDBIT bit 1 ]

let InitBCPL(paramvec) be
  [
  Version = (2 lshift 8) + 0
  SWAlto = false // default -- compile NOVA code

  TTOstream = OpenOutput(0)
  TTIstream = OpenInput(0)
  Ostream = TTOstream; Istream = TTIstream;

  let v = vec streamvecsize
  streamvec = v
  let streamtables = vec (streamvecsize+1)*STREAMsize

  FreeMax = paramvec!#37-1
 // Limits are Max's 
  DictFreeLimit = FreeMax - (paramvec!1+1)
  TreeFreeLimit = FreeMax - (paramvec!2+1)
  CodeFreeLimit = FreeMax - (paramvec!3+1)
  FileNameLength = 20
  GetFileMax = 12
  for i = 0 to 7 do
     [
     streamvec!i = streamtables
     streamtables = streamtables + STREAMsize + 1
     ]


// CALL THE COMPILER
  Main(paramvec)

  ]

and syscall(call, ac) = valof
[ let err = syscallproc(call, ac)
  if err eq -1 resultis 0
  if err eq 0  do err = #15
  resultis err
 ]

and Position(stream) = valof
[
  if stream ls 0 then resultis -1
  let channel = stream>>STREAM.channel
  unless 0 le channel & channel le 7 resultis -1
  let v = #430  //DOS channel table in page one
  let t = v!channel //DOS descriptor for the channel
  let bytenum = t!#25 //word 25 is byte number in current block
  let bloknum = t!#24 //word 24 is current block number
  let dospos = ((bloknum * 255) lshift 1) + bytenum
  if stream>>STREAM.action eq writeact then 
      resultis dospos + stream>>STREAM.count
  if dospos eq 0 then resultis 0
   resultis dospos - (stream>>STREAM.max - stream>>STREAM.count) -1
]

and bufferio(stream, opr, count) = valof
[
  sysac!0 = (lv stream>>STREAM.bytebuffer) lshift 1
  sysac!1  = count
  sysac!2 = stream>>STREAM.channel
  resultis syscall(opr, sysac)
]

and Help(Message) be
[
  let v = vec 3
  let m = vec 64
  Unpackstring(Message, m)
  for i = 1 to m!0 do [ v!0 = m!i; syscall(syspchar, v) ]
  Unpackstring(" -- HELP*n", m)
  for i = 1 to m!0 do [ v!0 = m!i; syscall(syspchar, v) ]

  sysdebugproc()

  return
]

and Readch(stream, lvc) be 
[Rch
  let numbytes = 1
ReadchKLUDGE:  // THIS IS THE ENTRY POINT FROM READWORD !!UGH!!!!
  let v = vec 2
  test stream eq -1
    ifso // tty simultation
      for i = 1 to numbytes do[ syscall(sysgchar, sysac)
      v!i = sysac!0 & #377    ]
  ifnot [fileio  //   talking to a real file!
   for i = 1 to numbytes do
   [mainloop
     let count = stream>>STREAM.count
     if count gr  stream>>STREAM.max then
       [ 
       let err = bufferio(stream, sysrds, maxstreambytes)
       let num = sysac!1
       stream>>STREAM.max =  num -1
    //displaystream(stream); WriteS("err=");WriteO(err);WW($*N)
       if err then unless err eq 6 do syscallerror(sysrds, sysac,
       stream)
       if num eq 0 then [
           v!1, v!2 = #777, #777
           break ]
       count = 0
       ]
     v!i = stream>>STREAM.bytebuffer↑count
     stream>>STREAM.count = count + 1
     loop
    ]mainloop
  ]fileio  //   talking to a real file!
//for i = 1 to numbytes do [ WW(v!i); WriteO(v!i); WW($*N) ]
  if numbytes eq 1 then
      [  @lvc = v!1; return ]
  v!2 <<LEFTHALF = v!1
  @lvc = v!2
]Rch

and Writech(stream, ch) be
[Wch
  let numbytes = 1
WritechKLUDGE:   // <<<< ENTRY POINT for  Writeword !!!! (UGH!!)
if stream>>STREAM.action ne writeact then [ WriteO(stream);
Help("writing a read stream")]
  let v = vec 2
  test numbytes eq 1
  ifso v!1 = ch
  ifnot [  v!1 = ch << LEFTHALF; v!2 = ch<<RIGHTHALF ]
 test stream eq -1 
   ifso for i = 1 to numbytes do [ sysac!0 = v!i
     syscall(syspchar, sysac)
     ]
ifnot [fileio 
 for i = 1 to numbytes do
 [mainloop

  let count = stream >>STREAM.count
  if count gr maxbyteindex then
    [
    if bufferio(stream, syswrs, maxstreambytes) then
      syscallerror(syswrs, sysac, stream)
    count = 0
    ]
   stream>>STREAM.bytebuffer↑count = v!i
   stream>>STREAM.count = count + 1
   loop
  ]mainloop
 ]fileio
]Wch

// note this code assumes the buffer begins and ends on
// even word boundries.
and Readword(stream, lvw) be
[
if stream>>STREAM.action ne readact then [ WriteO(stream);
Help("reading a write-stream")]
  let numbytes = 2
  let c = stream>>STREAM.count
  if c<<ODDBIT % (c + 1 gr stream>>STREAM.max) then goto ReadchKLUDGE
  @lvw = stream>>STREAM.wordbuffer↑(c rshift 1)
  stream>>STREAM.count = c +  2
  return
  let v = vec 25 // ALLOCATE ENOUGH STACK SPACE UGH,UGH!!! 
]

and Readaddr(stream, lva) be
[ Readaddr = Readword
  Readword(stream, lva)
]

and Writeword(stream, w) be
[
if stream>>STREAM.action ne writeact then [ WriteO(stream);
Help("writing a read stream")]
  let numbytes = 2
  let c = stream>>STREAM.count
if c<<ODDBIT % (c + 1 gr stream>>STREAM.max) then goto WritechKLUDGE // goto  is fast!  UGH!!!!!
  stream>>STREAM.wordbuffer↑(c rshift 1) = w 
  stream>>STREAM.count = c +  2
  return
  let v = vec 25 // ALLOCATE ENOUGH STACK SPACE UGH,UGH!!! 
]

and Writeaddr(stream, a) be
[ Writeaddr = Writeword
  Writeword(stream, a)
]
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
    [ sysac!0 = ch; syscall(syspchar, sysac)
    if newline do
      [ sysac!0 = #12; syscall(syspchar, sysac)
      if SWWait do Wait()  ]
    ]
  or
    [ Writech(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 = 20; waitdefault = 20 ]
  waitcount = waitcount - 1
  if waitcount ne 0 return

l:let v = vec 3
  v!0 = #7; syscall(syspchar, v)
  v!0 = $:; syscall(syspchar, v)
  let n = -1
  syscall(sysgchar, v)
  let ch = v!0 & #177

m:switchon ch into
    [ case #15: unless n eq -1 do waitdefault = n
       waitcount = waitdefault
       v!0 = #15; syscall(syspchar, v)
       return
    case #12: unless n ne -1 do n = 1
       waitcount = n
       v!0 = #15; syscall(syspchar, v)
       return
    case #33: Help("PAUSE")
       goto l
    case $0 to $9: syscall(syspchar, v)
       n = ch - $0
       [ syscall(sysgchar, v); ch = v!0 & #177
         unless $0 le ch & ch le $9 break
         syscall(syspchar, v)
         n = n*10 + (ch - $0)
       ] repeat
       goto m
    default: v!0 = $?; syscall(syspchar, v)
       goto l
   ]
 ]

and ReadSequential(stream,wd,ct) be
   [
   sysac!0 = wd lshift 1
 sysac!1 = ct lshift 1
  sysac!2 = stream>>STREAM.channel
   let err = syscall(sysrds,sysac)
   unless err return
   syscallerror(sysrds,sysac)
   ]

and WriteSequential(stream,wd,ct) be
   [
   sysac!0 = wd lshift 1
   sysac!1 = ct lshift 1
   sysac!2 = stream>>STREAM.channel
   let err = syscall(syswrs,sysac)
   unless err return
   syscallerror(syswrs,sysac)
   ]

and ReadWord(stream) = valof
   [
   let w = nil
   ReadSequential(stream,(lv w),1)
   resultis w
   ]
   
and WriteWord(stream,w) be
   WriteSequential(stream,(lv w), 1)

and dospointer(bcplname, dosname) = valof
[
  Movestring(bcplname, dosname)
  let n = dosname!0 rshift 8
  if (n & 1) eq 1 do dosname!(n/2+1) = 0
  resultis (dosname lshift 1)+1
]

and OpenInput(name) = valof
[
  if name eq 0 resultis -1
  if name!0 eq 0 resultis -1
  resultis newstream(name, readact)
 ]

and OpenOutput(name) = valof
[
  if name eq 0 resultis -1
  if name!0 eq 0 resultis -1

  let dosname = FileNameLength; Dvec(OpenOutput, lv dosname)
  sysac!0 = dospointer(name, dosname)
  let deleteerr = syscall(sysdelete, sysac)
  if deleteerr unless deleteerr eq #12 do
  [  Ostream = TTOstream
    WriteS("ERROR : CAN'T DELETE FILE *""); WriteS(name)
    WriteS("*"*n")
    finish
  ]
  let createerr = syscall(syscreate, sysac)
  if createerr do
    [  Ostream = TTOstream
       WriteS("ERROR : CAN'T CREATE FILE *""); WriteS(name)
      WriteS("*"*n")
      finish
    ]
  resultis newstream(name, writeact)
 ]

and OpenTemp(ch, inputflag; numargs nargs) = valof
[
  if nargs eq 1 then inputflag = false
  let name = FileNameLength/2; Dvec(OpenTemp,lv name)
  Unpackstring("$$$.B0", filename)
  filename!(filename!0) = ch
  FixFileName(name, "", "")
  let channel = inputflag? OpenInput(name), OpenOutput(name)
  resultis channel
 ]

and Reposition(stream, pos) be
[
  let channel = nil
  if stream ls 0 return
  flushbuffer(stream)
  if Position(stream) eq pos then return
  channel = stream>>STREAM.channel
  unless 0 le channel & channel le 7  then return
  let bloknum = (pos rshift 1) / 255
  let bytenum = pos - ((bloknum * 255) lshift 1)
  let v = #430
  let t = v!channel
  t!#25 = bytenum
  t!#24 = bloknum
  t!#17 = t!#17 % #4 //set "first write" bit in status word
  test stream>>STREAM.action eq writeact
      then stream>>STREAM.max = maxbyteindex
      or  readbuffer(stream)
]

and ResetStream(channel) be Reposition(channel, 0)

and IsFile(name) = valof
[
  let dosname = FileNameLength; Dvec(IsFile,lv dosname)
  sysac!0 = dospointer(name, dosname)
  sysac!1 = sysac!0
  let err = syscall(sysrename, sysac)
  resultis err ne #12
]

and InitToRead(stream) be
[
  if stream>>STREAM.action eq readact then return
  flushbuffer(stream)
  readbuffer(stream)
]

and openfile(bcplname) = valof
[ 
  let dosname = FileNameLength; Dvec(openfile,lv dosname)
  if bcplname eq 0 resultis -1
  if bcplname!0 eq 0 resultis -1

  let channel = 7
  let v = #430  //DOS channel table in page one
  for i = 0 to 7 do
      if (v!i & #100000) ne 0 do [ channel = i; break ]

  sysac!0 = dospointer(bcplname, dosname)
  sysac!1 = 0
  sysac!2 = channel
  let err = syscall(sysopen, sysac)
  if err then channel = sysac!2 + #1000
  let s = 0
  for i = 0 to 7 do // there are seven channels possobile
    [
    if streamvec!i ls 0 loop
    s = streamvec!i
    streamvec!i = s + #100000
    break
    ]
  if s eq 0 then [    WriteS("can't open ")
      WriteS(bcplname)
      Error("--out of streams")
      ]
  s>>STREAM.channel = channel
  s>>STREAM.max = maxbyteindex

resultis s
]

and closechannel(stream) be
[
  if stream eq -1 return
  flushbuffer(stream)
  sysac!2 = stream>>STREAM.channel
  let err = syscall(sysclose, sysac)
  if err do
    syscallerror(sysclose, sysac, stream)
  returnstream(stream)
]

and newstream(name, action) = valof
[
  let s = openfile(name)
  if s>>STREAM.channel gr #1000 do
    [
    Ostream = TTOstream
    let m = s>>STREAM.channel eq #1012 ?
      "ERROR : NO FILE NAMED *"" ,
         s>>STREAM.channel eq #1021 ?
          "ERROR : NO FREE CHANNEL FOR *"" ,
            "ERROR : CAN'T OPEN FILE *""
    WriteS(m); WriteS(name); WriteS("*"*n")
    finish
    ]
  s>>STREAM.action = action
  s>>STREAM.count = 0
  test action eq readact
    ifso readbuffer(s)
    ifnot s>>STREAM.max = maxbyteindex
  resultis s
]

and returnstream(stream) be
[
  for i = 0 to 7 do
    [
    if (streamvec!i & #77777) eq stream then
      [
      streamvec!i = stream
      return
      ]
    ]
  Error("can't return stream")
]

and flushbuffer(stream) be
[
  if stream>>STREAM.action eq writeact then 
        [
        if (stream>>STREAM.count ne 0) then 
        bufferio(stream, syswrs, stream>>STREAM.count )
        ]
  stream>>STREAM.count = 0
  stream>>STREAM.max = maxbyteindex
]
and readbuffer(stream) be
[
  bufferio(stream, sysrds, maxstreambytes)
  stream>>STREAM.max =  sysac!1 -1
  stream>>STREAM.count =  0
  stream>>STREAM.action = readact
]

and displaystream(s) be
[
  WriteS("*NDisplay a stream...*N")
  for i = 0 to (offset STREAM.bytebuffer+15)/16 do WriteO(s!i)
  WriteS("*N")
]

and Overlay(name, loc) be
[
  let s = openfile(name) //circumvent "OpenInput" because we don't
//  want io buffered for us
  let ch = s>>STREAM.channel
  let h = vec 15
  sysac!0 = h lshift 1
  sysac!1 = 32
  sysac!2 = ch
  syscall(sysrds, sysac)
  sysac!0 = loc lshift 1
  sysac!1 = h!1 lshift 1
  sysac!2 = ch
  syscall(sysrds, sysac)
  let n = nil
  sysac!0 = lv n lshift 1
  sysac!1 = 2
  sysac!2 = ch
  syscall(sysrds, sysac)
  let p =vec 1
  for i = 1 to n do
  [ sysac!0 = p lshift 1
    sysac!1 = 4
    sysac!2 = ch
    syscall(sysrds, sysac)
    @(p!0) = p!1 + loc
  ]
  closechannel(s)
]

and ReadCOMCM() be
[	//read the next name and switch list from COM.CM
  static [ cstream = #100000 ]
  if cstream eq #100000 do cstream = OpenInput("COM.CM")
  let i = 1
  [	Readch(cstream, lv filename!i)
	if filename!i eq 0 break
	if i gr FileNameLength do Error("BAD FILE NAME")
	if filename!i eq #377 do
	  [	CloseInput(cstream)
		filename!0 = -1
		cstream = #100000 ///*DCS* so can re-read in LEX
		return
	    ]
	i = i + 1
  ] repeat
  filename!0 = i-1

  let s = nil
  let i, j = 0, 0
  for k = 1 to 4 do
    [	Readch(cstream, lv s)
	for l = 1 to 8 do
	  [	if (s & #200) ne 0 do
		  [	j = j + 1
			sw!j = i + $A
		    ]
		i = i + 1
		s = s lshift 1
	    ]
      ]
  sw!0 = j
 ]

and InitFree(max) be
[ FreelistP = max
  rv zframemax = max
]

and Newvec(n) = valof
[ let v = FreelistP - n
  if v ls lv v do
	[ rv zframemax = rv zframemax + 1000
	  Error("OUT OF FREE STORAGE -- PROGRAM IS TOO BIG")
	]
  FreelistP = v - 1
  rv zframemax = v
  resultis v
]

and Dvec(rout,lvN) be
[ let rslt = (lv rout)-4
  let FSO() be [ let v = vec 31000; v = v ]
  let newMax = rslt + @lvN + 1
  if newMax > @zframemax then FSO()
  @zframenext = newMax
  @lvN = rslt
//***!!!  This will stop working if RETURN code is changed
  rslt = (@zreturn)+1 // bypass resetting zframenext
  rslt() // returns
]