LET FindStream(direction, name) = VALOF
$(
   result2 := 0
   SWITCHON FindArg("VDU:,RS423:,RS232:,PRINTER:,,NULL:", name) INTO
      $(
      CASE 0 :
	 RESULTIS vdustream

      CASE 1 :
      CASE 2 :
	 RESULTIS make.serial.stream(direction, name)

      CASE 3 :
	 RESULTIS make.printer.stream(direction, name)

      CASE 4 :
      CASE 5 :
	 RESULTIS make.new.stream(name,
				   s.is.null.bits,
				   direction,
				   null.reader,  // rdch()
				   nothing)	 // wrch()
      DEFAULT :
	 TEST name%(name%0) = ':' THEN
	    RESULTIS 0
	 ELSE
	    TEST FindStoreFile(name) = 0 THEN
	       RESULTIS MakeFileStream(direction, name)
	    ELSE
	       RESULTIS MakeStoreStream(direction, name)
      $)
$)

AND MakeStoreStream(direction, name) = VALOF
$( LET stream = ?
   LET store.control.block = find.store.file(name)

   LET StoreRdch(channel) = VALOF
   $( LET ch = ?
      TEST cis!s.buffer.pointer>=cis!s.buffer.count THEN
	 RESULTIS endstreamch
      ELSE $(
	 ch := (cis!s.buffer.address)%(cis!s.buffer.pointer)
	 cis!s.buffer.pointer := cis!s.buffer.pointer + 1
	 RESULTIS ch $)
   $)

   AND StoreWrch(ch, channel) BE
   $( LET n = cos!s.buffer.count;
      IF n>=cos!s.buffer.size THEN
	 Fault("Store file full",e.store.file.full)
      (cos!s.buffer.address)%n := ch
      cos!s.buffer.count := n+1
   $)

   AND StoreEndwrite(stream) BE
   $( stream!s.channel!store.size := stream!s.buffer.count
      end.stream(stream)
   $)

   stream := make.new.stream(name,
			     s.is.store.bits,
			     direction,
			     StoreRdch,
			     StoreWrch)

   stream!s.endwriter := StoreEndwrite

   stream!s.channel := store.control.block

   stream!s.buffer.size    := store.control.block!store.maxsize
   stream!s.buffer.address := store.control.block!store.start
   stream!s.buffer.count   := direction = s.op.input ->
				  store.control.block!store.size,
				  0
   stream!s.buffer.pointer := 0

   RESULTIS stream

$)

/***************************************************************************
 *
 * The store file management routines
 *
 ***************************************************************************/

AND FindStoreFile(name) = VALOF
$(/* To search for a named instore file */
  LET pointer = storechain
  WHILE pointer~=0 DO $(
     IF CompString(name,@pointer!store.name)=0 THEN BREAK
     pointer := pointer!store.nextfile $)
  RESULTIS pointer
$)

AND MakeStoreFile(name, size) = VALOF
$( LET file = ?

   IF FindStoreFile(name)~=0 THEN RESULTIS 0
   file := GetVec(store.block.size)
   IF file=0 THEN
      Fault("No room for store file block", e.no.work.space)
   file!store.magic := s.is.a.store.file
   FOR i = 0 TO s.name.max.size-1 DO
      (@(file!store.name))%i := i>name%0 -> ' ', name%i
   IF name%0 >= s.name.max.size THEN
      (@(file!store.name))%0 := s.name.max.size - 1
   file!store.size := 0
   file!store.maxsize := size
   file!store.start := GetVec((size+3) >> 2)
   IF file!store.start=0 THEN $(
      FreeVec(file)
      Fault("No room for store file", e.no.work.space) $)

   /* Now link the new file onto the chain */

   file!store.nextfile := storechain
   storechain := file

   RESULTIS file

$)


AND loadfile(fileName, alias) = VALOF
$(/* get a disc file into the store system */

   LET storeName = alias%0 = 0 -> fileName, alias
   LET file = ?
   LET osfileBuffer = VEC 3
   LET temp = 0

/* first find out how big the file is (if it exists) */

   temp := OsFile(5, fileName, osfileBuffer)
   IF temp~=1 THEN $(
      result2 := temp
      RESULTIS 0 $)
   file := MakeStoreFile(storeName, osfileBuffer!2)
   file!store.size := osfileBuffer!2
   osfileBuffer!0 := file!store.start << 2
   osfileBuffer!1 := 0
   IF OsFile(255, fileName, osfileBuffer) < 0 THEN $(
      Fault("Cant load store file", e.cant.load.file)
      RESULTIS 0 $)
   RESULTIS file
$)


AND vdu(string, a1, a2, a3, a4, a5, a6, a7, a8, a9, a0) BE
$(/* to emulate the BBC BASIC vdu statement.
    * The given string contains a list of numbers which will be sent to
    * the screen.
    * The numbers are treated as decimal but may be escaped by # and one
    * of D, O, H, or a digit (specifying radix 10, 8, 16, or 8).
    * A number following an & is treated as hexadecimal.
    * A % character yields the value of the next argument in the argument list.
    * If a number is followed by a ; then two bytes are sent to the screen
    * the low byte and then the high byte of the number.
    * If a number is followed by a, then one byte is sent to the screen.
    * If a number is the last thing in the string then a byte is sent to the
    * screen (as if it had been followed by a comma)
    * Spaces are ignored.
    *
    * examples :
    *
    * vdu("1, 2, 3, 4") 		VDU 1,2,3,4
    * vdu("257; 258 ;") 		  VDU 1,1,2,1
    * vdu("#x21,#x0D")			  VDU 33,13
    * vdu("%,%;", 9, 513)		VDU 9,1,2
    */

   LET ch = ?
   LET ch.position = 1
   LET radix = 10
   LET number = 0
   LET number.pending = FALSE
   LET arg.pointer = @a1

   WHILE ch.position<=string%0 DO $(
      ch := string%ch.position
      SWITCHON ch INTO
      $( CASE ' ' :
	    ENDCASE

	 CASE ';' :
	    binwrch(number & #xFF)
	    number := number >> 8
	 CASE ',' :
	    binwrch(number & #xFF)
	    number := 0
	    number.pending := FALSE
	    radix := 10
	    ENDCASE

	 CASE '&' :
	    radix := 16
	    ENDCASE

	 CASE '%' :
	    IF (string%(ch.position + 1) = 'N') \/
	       (string%(ch.position + 1) = 'n') THEN
	       ch.position := ch.position + 1
	    number := !arg.pointer
	    number.pending := TRUE
	    arg.pointer := arg.pointer + 1
	    ENDCASE

	 CASE '0' : CASE '1' : CASE '2' : CASE '3' : CASE '4' :
	 CASE '5' : CASE '6' : CASE '7' : CASE '8' : CASE '9' :
	 CASE 'A' : CASE 'B' : CASE 'C' :
	 CASE 'D' : CASE 'E' : CASE 'F' :
	 CASE 'a' : CASE 'b' : CASE 'c' :
	 CASE 'd' : CASE 'e' : CASE 'f' :
	    number := ReadDigit(number, radix, ch)
	    number.pending := TRUE
	    ENDCASE

	 CASE '#' :
	    ch.position := ch.position + 1
	    IF ch.position > string%0 THEN
	       BREAK
	    SWITCHON string%ch.position INTO
	    $( CASE 'D' : CASE 'd' :
		  radix := 10
		  ENDCASE

	       CASE 'O' : CASE 'o' :
		  radix := 8
		  ENDCASE

	       CASE 'X' : CASE 'x' :
		  radix := 16
		  ENDCASE

	       CASE '0' : CASE '1' : CASE '2' : CASE '3' :
	       CASE '4' : CASE '5' : CASE '6' : CASE '7' :
		  ch.position := ch.position - 1
		  radix := 8
		  ENDCASE
	       $)
	    ENDCASE
      $)
      ch.position := ch.position + 1
   $)
   IF number.pending THEN
      binwrch(number & #xFF)
$)


AND ReadDigit(oldNumber, radix, ch) = VALOF
$( LET newNumber = 0

   SWITCHON ch INTO
   $( CASE '8' : CASE '9' :
	 IF radix=8 THEN ENDCASE;

      CASE '0' : CASE '1' : CASE '2' : CASE '3' :
      CASE '4' : CASE '5' : CASE '6' : CASE '7' :
	 newNumber := oldNumber*radix + ch - '0'
	 ENDCASE

      CASE 'A' : CASE 'B' : CASE 'C' :
      CASE 'D' : CASE 'E' : CASE 'F' :
	 IF radix=16 THEN newNumber := oldNumber*radix + ch-'A'+10
	 ENDCASE

      CASE 'a' : CASE 'b' : CASE 'c' :
      CASE 'd' : CASE 'e' : CASE 'f' :
	 IF radix=16 THEN newNumber := oldNumber*radix + ch-'a'+10
	 ENDCASE
   $)
   RESULTIS newNumber
$)


$<debug
AND WriteDebug(format, a, b, c, d, e, f, g, h, i, j, k, l) BE
$( LET oldOutput = cos
   SelectOutput(vdustream)
   WriteF(format, a, b, c, d, e, f, g, h, i, j, k, l)
   SelectOutput(oldOutput)
$)

AND describestream(stream) BE
$( IF stream!s.magic~=s.is.a.stream THEN $(
      WriteF("Stream %x8 is not a stream*N", stream)
      RETURN $)
   WriteDebug("Stream %x8 :*N", stream)
   WriteDebug("s.magic         = *"%s*"*N", "is a stream")
   WriteDebug("s.stream.chain  = %x8*N", stream!s.stream.chain)
   WriteDebug("s.flags         = %x8*N", stream!s.flags)
   WriteDebug("s.name          = *"%s*"*N", @(stream!s.name))
   WriteDebug("s.error.handler = %s()*N", ProcName(stream!s.error.handler))
   WriteDebug("s.channel       = %n*N", stream!s.channel)
   WriteDebug("s.selecter      = %s()*N", ProcName(stream!s.selecter))
   WriteDebug("s.reader        = %s()*N", ProcName(stream!s.reader))
   WriteDebug("s.writer        = %s()*N", ProcName(stream!s.writer))
   WriteDebug("s.unreader      = %s()*N", ProcName(stream!s.unreader))
   WriteDebug("s.last.char     = %x8*N", stream!s.last.char)
   WriteDebug("s.real.reader   = %s()*N", ProcName(stream!s.real.reader))
   WriteDebug("s.error.count   = %n*N", stream!s.error.count)
   WriteDebug("s.last.error    = %x8*N", stream!s.last.error)
   WriteDebug("s.endreader     = %s()*N", ProcName(stream!s.endreader))
   WriteDebug("s.endwriter     = %s()*N", ProcName(stream!s.endwriter))
   WriteDebug("*N")
$)


AND ProcName(proc) = VALOF
$( IF 0%(proc-8)=7 THEN RESULTIS (proc-8)/bytesperword
   RESULTIS "<Not a procedure>"
$)
$>debug
