// BCPL1.bcpl - BCPL Compiler -- IO routines
// Copyright Xerox Corporation 1980
// Use Dvec to allocate FileNameLength -- Swinehart, 6 May 77

get "bcplx"
get "bcpliox"

structure [ blank bit 15; ODDBIT bit 1 ]

let Packstring(u, p) be
 [
  let n = u!0
  let i, j = 0, 0
  [ p!j = u!i lshift 8
    i = i + 1; if i gr n return
    p!j = p!j + (u!i & #377)
    i = i + 1; if i gr n return
    j = j + 1
  ] repeat
 ]

and Unpackstring(p, u) be
[
  let n = p!0 rshift 8
  let i, j = 0, 0
  [ u!i = p!j rshift 8
    i = i + 1; if i gr n return
    u!i = p!j & #377
    i = i + 1; if i gr n return
    j = j + 1
  ] repeat
 ]

and Movestring(p1, p2) be
[
  let n = p1!0 rshift 8
  test n eq 0
  then n = p1!0
  or   n = n/2
  for i = 0 to n do p2!i = p1!i
 ]

and Length(p) = p!0 rshift 8

and Char(p, n) = valof
[
  let i = n rshift 1
  test (n & 1) eq 0
  then resultis p!i rshift 8
  or   resultis p!i & #377
 ]

and WriteS(s) be
[ let u = vec 256
  Unpackstring(s, u)
  for i = 1 to u!0 do WW(u!i)
 ]

and WriteN(n) be
[ if n ls 0 do [ n = -n; WW($-) ]
  let zsw = false
  let k = 10000
  for i = 1 to 4 do
    [ let d = n/k
     if zsw % (d ne 0) do
        [ WW(d+$0); zsw = true ]
     n = n rem k
     k = k/10
    ]
  WW(n+$0)
 ]

and WriteO(n) be
[ let zsw = true
  for i = 15 to 3 by -3 do
    [ let d = (n rshift i) & #7
     test zsw & (d eq 0)
     then [ WW($*s) ]
     or   [ WW(d+$0); zsw = false ]
    ]
  WW((n & #7) + $0)
 ]

and CloseInput(channel) be closechannel(channel)  

and CloseOutput(channel) be closechannel(channel) // will flush buffer in closechannel

and CloseTemp(channel, ch) be closechannel(channel) // will flush buffer in closechannel

and syscallerror(call, ac, stream; numargs nargs) be
[ let callac = vec 3; for i = 0 to 3 do callac!i = ac!i

  Ostream = TTOstream
  WriteS("UNEXPECTED SYSTEM CALL ERROR ")
  WriteO(callac!2)

  [ WriteS(" ON CALL "); WriteO(call); WW($*n) ]
  if SWHelp do Help("SYSTEM CALL ERROR")
  finish
 ]

and BadSwitch(i) be
[	//illegal switch detected -- abort
  Ostream = TTOstream
  let n = FileNameLength/2; Dvec(BadSwitch,lv n); Packstring(filename, n)
  WriteS(n)
  for i = 1 to sw!0 do [ WW($/); WW(sw!i) ]
  WriteS(" -- BAD SWITCH "); WW(sw!i); WW($*n)
  if SWHelp do Help("HELP")
  finish
 ]

and Error(message) be
[	//fatal error detected -- abort
  Ostream = TTOstream
  WW($*n); WriteS(message); WW($*n)
  if SWHelp do Help("HELP")
  finish
 ]

and FixFileName(Newname, ext, dev) be
[	
  let udev = FileNameLength; Dvec(FixFileName, lv udev)
  let devsw = false
  let n = 0
  [ n = n + 1
    if n gr filename!0 do
      [	let v = vec 3
	Unpackstring(ext, v)
	for i = 1 to v!0 do filename!(n+i-1) = v!i
	filename!0 = filename!0 + v!0
	break
       ]
    if filename!n eq $. break
    if filename!n eq $: do devsw = true
  ] repeat
  let uname = filename
  test dev ne 0 & dev!0 ne 0 & not devsw then Unpackstring(dev, udev)
					 or udev!0 = 0
  if udev!0 ge 4 & udev!4 eq $: do
    [	
	uname = filename - 4
	uname!0 = filename!0 + 4
	for i = 1 to 4 do uname!i = udev!i
     ]
  if uname!(uname!0) eq $. do uname!0 = uname!0 - 1
  Packstring(uname, Newname)
  filename!0 = n - 1
 ]

and DecValue(name) = valof
[	//get decimal number from unpacked string
  let n = 0
  for i = 1 to name!0 do
    [	unless $0 le name!i & name!i le $9 do
		Error("BAD DECIMAL NUMBER")
	n = n*10 + (name!i-$0)
     ]
  resultis n
 ]

and OctValue(name) = valof
[	//get octal number from unpacked string
  let n = 0
  for i = 1 to name!0 do
    [	unless $0 le name!i & name!i le $7 do
		Error("BAD OCTAL NUMBER")
	n = n*8 + (name!i-$0)
     ]
  resultis n
 ]

and Zerovec(n) = valof
[ let v = Newvec(n)
  for i = 0 to n do v!i = 0
  resultis v
]
and List1(a) = valof
[ let v = Newvec(1-1)
  v!0 = a
  resultis v
]
and List2(a,b) = valof
[ let v = Newvec(2-1)
  v!0, v!1 = a, b
  resultis v
]
and List3(a,b,c) = valof
[ let v = Newvec(3-1)
  v!0, v!1, v!2 = a, b, c
  resultis v
]
and List4(a,b,c,d) = valof
[ let v = Newvec(4-1)
  v!0, v!1, v!2, v!3 = a, b, c, d
  resultis v
]
and List5(a,b,c,d,e) = valof
[ let v = Newvec(5-1)
  v!0, v!1, v!2, v!3, v!4 = a, b, c, d, e
  resultis v
]
and List6(a,b,c,d,e,f) = valof
[ let v = Newvec(6-1)
  v!0, v!1, v!2, v!3, v!4, v!5 = a, b, c, d, e, f
  resultis v
]
and List7(a,b,c,d,e,f,g) = valof
[ let v = Newvec(7-1)
  v!0, v!1, v!2, v!3, v!4, v!5, v!6 = a, b, c, d, e, f, g
  resultis v
]

and Nextparam() = valof
[ static [ nextp = 0 ]
  nextp = nextp + 1; resultis nextp
]
and Nextentry() = valof
[ static [ nexte = 0 ]
  nexte = nexte + 1; resultis nexte
]
and Nextstatic() = valof
[ static [ nexts = 0 ]
  nexts = nexts + 1; resultis nexts
]