import "util"
import "iosb"
import "heap"

/*
  devctl(dc$..., ...) error returns

  error     BCPL
  code  constant name     cause
  
    -1  err$badcode       first parameter (dc$...) invalid
    -2  err$readparams    at least one of the parameters is in memory that is inaccessible
    -3  err$devnumber     unit number outside valid range
    -4  err$position      disc block number < 0 or >= number of blocks
    -5  err$memory        the memory pointed to by a parameter is inaccessible
    -6  err$devfailed     a failure in the real Unix world, e.g. file could not be updated
    -7  err$notfound      for tape operations, real Unix file inaccessible
    -8  err$badparam      a parameter had an invalid value, e.g. 'X' for the 'R'/'W' in tapeload
    -9  err$inuse         netss: starting network device that has already been started
                          tapeload: unit already has a tape loaded
   -10  err$cantcreate    netss: emulated IP address already in use
   -11  err$nodata        netrcv: no data received (yet)
   -12  err$software      for your own use, nothing in the emulator produces this error code
*/

let error_names = table "NONE", "BADCODE", "READPARAMS", "DEVNUMBER", "POSITION", "MEMORY",
                        "DEVFAILED", "NOTFOUND", "BADPARAM", "INUSE", "CANTCREATE", "NODATA",
                        "SOFTWARE";

manifest
{ last_error = -12,

  superblock_pos = 0,

  sb_rootdir = 0,                // sb_... superblock entry items
  sb_firstfreeblock = 1,
  sb_datetime = 2,
  sb_name = 3,
  sb_name_lengthwords = 3,

  de_name = 0,                   // de_... directory entry items
  de_name_lengthwords = 3,
  de_length = 3,
  de_datetime = 4,
  de_blocknum = 5,
  sizeof_de = 6,
  max_num_de = 128 / sizeof_de,
  
  iosb_dirent = iosb_extra_1,
  iosb_discloc = iosb_extra_2 }

let command_loop = nil;

let disc_numblocks = 0;
let disc_mounted = false;
let superblock_copy = vec(128);
let rootdir_copy = vec(128);

let error_reason = nil;

let perror(code, message1, message2) be
{ test code >= 0 then
  { emergency_outs("\nNot an error, code");
    emergency_outno(code) }
  or test code = EOF then
    emergency_outs("\nEnd of file")
  or test code < last_error then
  { emergency_outs("\nUnrecognised error code ");
    emergency_outno(code) }
  or
  { emergency_outs("\nError code ");
    emergency_outno(code);
    emergency_outch(' ');
    emergency_outs(error_names ! - code) }
  emergency_outs(", ");
  emergency_outs(message1);
  emergency_outch(' ');
  emergency_outs(message2);
  emergency_outch('\n');
  if error_reason <> nil then
  { emergency_outs("reason: ");
    emergency_outs(error_reason);
    error_reason := nil;
    emergency_outch('\n') } }

let equals(a, b) be
{ let i = 0;
  while true do
  { let ca = byte i of a, cb = byte i of b;
    if ca <> cb then
      resultis false;
    if ca = 0 then
      resultis true;
    i +:= 1 } }

let begins_with(a, b) be
{ let i = 0;
  while true do
  { let ca = byte i of a, cb = byte i of b;
    if ca <> cb then
      resultis cb = 0;
    if ca = 0 then
      resultis true;
    i +:= 1 } }

let equals_after(a, skip, b) be
{ let i = 0, j = 0;
  while i < skip do
  { if byte i of a = 0 then
      resultis false;
    i +:= 1 }
  while true do
  { let ca = byte i of a, cb = byte j of b;
    if ca <> cb then
      resultis false;
    if ca = 0 then
      resultis true;
    i +:= 1;
    j +:= 1 } }

let skip_chars_in(num, str) be
{ let i = 0, j = 0, c;
  while i < num do
  { c := byte i of str;
    if c = 0 then
    { byte 0 of str := 0;
      return }
    i +:= 1 }
  while true do
  { c := byte i of str;
    byte j of str := c;
    if c = 0 then
      return;
    i +:= 1;
    j +:= 1 } }

let strcpy_n_to_n(a, wordsa, b) be                  // normal to normal
{ let maxa = wordsa * 4 - 2, idx = 0, c;
  while idx <= maxa do
  { c := byte idx of b;
    if c = 0 then
      break;
    byte idx of a := c;
    idx +:= 1 }
  byte idx of a := 0 }

let strcpy_f_to_f(a, wordsa, b, wordsb) be          // fixed to fixed
{ let maxa = wordsa * 4 - 1, maxb = wordsb * 4 - 1, idx = 0, c;
  while idx <= maxa do
  { test idx <= maxb then
      c := byte idx of b
    else
      c := 0;
    byte idx of a := c;
    idx +:= 1 } }

let strcpy_n_to_f(a, wordsa, b) be                  // normal to fixed
{ let maxa = wordsa * 4 - 1, idx = 0, c;
  while idx <= maxa do
  { c := byte idx of b;
    if c = 0 then
      break;
    byte idx of a := c;
    idx +:= 1 }
  while idx <= maxa do
  { byte idx of a := 0;
    idx +:= 1 } }

let strcpy_f_to_n(a, wordsa, b, wordsb) be          // fixed to normal
{ let maxa = wordsa * 4 - 2, maxb = wordsb * 4 - 1, idx = 0, c;
  while idx <= maxa do
  { c := byte idx of b;
    if c = 0 then
      break;
    byte idx of a := c;
    idx +:= 1 }
  byte idx of a := 0 }

let write_fixed(iosb, s, words, f) be
{ let max = words * 4 - 1, i = 0, full = false;
  if numbargs() > 3 then
    full := f;
  while i <= max do
  { let c = byte i of s;
    test c = 0 then
      test full then
        writech(iosb, ' ')
      or
        break
    or
      writech(iosb, c);
    i +:= 1 } }

let format_disc(name) be
{ let r;
  r := devctl(dc$discclear, 1);
  if r < 0 then
    returnto(command_loop, r);
  disc_numblocks := devctl(dc$disccheck, 1);
  if disc_numblocks < 3 then
  { error_reason := "devctl(dc$disccheck failed in format";
    returnto(command_loop, err$software) }
  $memory_zero(superblock_copy, 128);
  superblock_copy ! sb_rootdir := 1;
  superblock_copy ! sb_firstfreeblock := 2;
  superblock_copy ! sb_datetime := seconds();
  strcpy_n_to_f(superblock_copy + sb_name, sb_name_lengthwords, name);
  r := devctl(dc$discwrite, 1, superblock_pos, superblock_copy);
  if r < 0 then
    returnto(command_loop, r);
  $memory_zero(rootdir_copy, 128);
  r := devctl(dc$discwrite, 1, superblock_copy ! sb_rootdir, rootdir_copy);
  if r < 0 then
    returnto(command_loop, r);
  resultis disc_numblocks }

let mount_disc() be
{ let r;
  disc_numblocks := devctl(dc$disccheck, 1);
  if disc_numblocks < 3 then
  { error_reason := "devctl(dc$disccheck failed in mount";
    returnto(command_loop, err$software) }
  r := devctl(dc$discread, 1, superblock_pos, superblock_copy);
  if r < 0 then
    returnto(command_loop, r);
  r := devctl(dc$discread, 1, superblock_copy ! sb_rootdir, rootdir_copy);
  if r < 0 then
    returnto(command_loop, r);
  disc_mounted := true;
  resultis disc_numblocks }

let dismount_disc() be
{ let r;
  unless disc_mounted do
    resultis 1;
  r := devctl(dc$discwrite, 1, superblock_pos, superblock_copy);
  if r < 0 then
    returnto(command_loop, r);
  r := devctl(dc$discwrite, 1, superblock_copy ! sb_rootdir, rootdir_copy);
  if r < 0 then
    returnto(command_loop, r);
  disc_mounted := false;
  resultis 1; }

let show_superblock() be
{ unless disc_mounted do
    mount_disc();
  write(tty, "number of blocks: %d\n", disc_numblocks);
  write(tty, "disc name: \"%0*s\"\n", sb_name_lengthwords * 4, superblock_copy + sb_name);
  write(tty, "formatted: %t\n", superblock_copy ! sb_datetime);
  write(tty, "root directory is in block %d\n", superblock_copy ! sb_rootdir);
  write(tty, "first free block is block %d\n", superblock_copy ! sb_firstfreeblock) }

let show_root_directory() be
{ let total = 0;
  unless disc_mounted do
    mount_disc();
  for offset = 0 to 127 by sizeof_de do
  { if rootdir_copy ! offset = 0 then
      loop;
    total +:= 1;
    write(tty, "%*s %t at block %d, length %d bytes\n",
               de_name_lengthwords * 4, rootdir_copy + offset + de_name, rootdir_copy ! (offset + de_datetime),
               rootdir_copy ! (offset + de_blocknum), rootdir_copy ! (offset + de_length)); }
  write(tty, "total %d files\n", total) }

let get_root_directory_entry(fname) be
{ let thisname = vec(de_name_lengthwords + 1);
  for offset = 0 to 127 by sizeof_de do
    if rootdir_copy ! offset <> 0 then
    { strcpy_f_to_n(thisname, de_name_lengthwords + 1, rootdir_copy + offset + de_name, de_name_lengthwords);
      if thisname %equals fname then
        resultis rootdir_copy + offset; }
  error_reason := "file not found";
  resultis err$software }

let get_free_block() be
{ let b = superblock_copy ! sb_firstfreeblock;
  if b >= disc_numblocks then
  { error_reason := "disc is full";
    resultis err$software }
  superblock_copy ! sb_firstfreeblock +:= 1;
  resultis b }
  
let enter_into_root_directory(fname, blocknum) be
{ unless disc_mounted do
    mount_disc();
  for offset = 0 to 127 by sizeof_de do
    if rootdir_copy ! offset = 0 then
    { let entry = rootdir_copy + offset;
      strcpy_n_to_f(entry + de_name, de_name_lengthwords, fname);
      entry ! de_length := 0;
      entry ! de_datetime := seconds();
      entry ! de_blocknum := blocknum;
      resultis offset }
  error_reason := "root directory full";
  resultis err$software }

let writechar_disc(iosb, c) be
{ if iosb ! iosb_pos >= iosb ! iosb_size then
  { error_reason := "file too big";
    resultis err$software }
  byte iosb ! iosb_pos of iosb ! iosb_buffer := c;
  iosb ! iosb_pos +:= 1;
  resultis 1; }

let readchar_disc(iosb) be
{ let c;
  if iosb ! iosb_pos >= iosb ! iosb_size then
    resultis EOF;
  c := byte iosb ! iosb_pos of iosb ! iosb_buffer;
  iosb ! iosb_pos +:= 1;
  resultis c; }

let unreadchar_disc(iosb) be
{ if iosb ! iosb_pos <= 0 then
  { error_reason := "unreadchar at beginning of file";
    resultis err$software }
  iosb ! iosb_pos -:= 1;
  resultis 1 }

let close_disc_r(iosb) be
{ freevec(iosb ! iosb_buffer);
  freevec(iosb);
  resultis 1 }

let close_disc_w(iosb) be
{ if iosb ! iosb_pos > 0 then
  { let r = devctl(dc$discwrite, 1, iosb ! iosb_discloc, iosb ! iosb_buffer);
    if r < 0 then
      resultis r;
    rootdir_copy ! (iosb ! iosb_dirent + de_length) := iosb ! iosb_pos }
  freevec(iosb ! iosb_buffer);
  freevec(iosb);
  resultis 1 }

let disc_open_w(fname) be
{ let b, e, r;
  b := get_free_block();
  if b < 0 then
    resultis b;
  e := enter_into_root_directory(fname, b);
  if e < 0 then
    resultis e;
  r := newvec(sizeof_iosb);
  r ! iosb_ichar := illegal_readch;
  r ! iosb_bchar := illegal_unreadch;
  r ! iosb_ochar := writechar_disc;
  r ! iosb_close := close_disc_w;
  r ! iosb_unit := 1;
  r ! iosb_buffer := newvec(128);
  r ! iosb_pos := 0;
  r ! iosb_size := 512;
  r ! iosb_discloc := b;
  r ! iosb_dirent := e;
  resultis r }

let disc_open_r(fname) be
{ let v, r, e = get_root_directory_entry(fname);
  if e < 0 then
    resultis e;
  r := newvec(sizeof_iosb);
  r ! iosb_ichar := readchar_disc;
  r ! iosb_bchar := unreadchar_disc;
  r ! iosb_ochar := illegal_writech;
  r ! iosb_close := close_disc_r;
  r ! iosb_unit := 1;
  r ! iosb_buffer := newvec(128);
  r ! iosb_pos := 0;
  r ! iosb_size := e ! de_length;
  v := devctl(dc$discread, 1, e ! de_blocknum, r ! iosb_buffer);
  if v < 0 then
  { freevec(r ! iosb_buffer);
    freevec(r);
    error_reason := "failed to read file contents";
    resultis v }    
  resultis r }

let open(fname, mode) be
{ let open_disc(fname, read) be
  { unless disc_mounted do
      mount_disc();
    test read then
      resultis disc_open_r(fname)
    or
      resultis disc_open_w(fname) }

  let read;
  test mode = 'r' \/ mode = 'R' then
    read := true
  or test mode = 'w' \/ mode = 'W' then
    read := false
  or
  { error_reason := "invalid mode for open";
    resultis err$software }
  test fname %begins_with "d/" then
  { skip_chars_in(2, fname);
    resultis open_disc(fname, read) }
  or test fname %begins_with "t/" then
  { skip_chars_in(2, fname);
    test read then
      resultis tape_open_r(fname)
    or
      resultis tape_open_w(fname) }
  or test fname %equals "tty/" then
    resultis tty
  or
    resultis open_disc(fname, read) }

let delete_file(fname) be
{ let e;
  test fname %begins_with "t/" then
  { error_reason := "Can't delete tape files\n";
    returnto(command_loop, err$software) }
  or if fname %equals "tty/" then
  { error_reason := "Can't delete keyboard or monitor\n";
    returnto(command_loop, err$software) }
  if fname %begins_with "d/" then
    skip_chars_in(2, fname);
  e := get_root_directory_entry(fname);
  if e < 0 then
    resultis e;
  e ! de_name := 0;
  resultis 1 }

let create_file_from_file(tof, fromf) be
{ let line = vec(40), r, prompt = false;
  if fromf = tty then
  { abandon_input_line(tty);
    writestr(tty, "enter lines of text, lone * for end\n");
    prompt := true; }
  while true do
  { if prompt then
      writestr(tty, "< ");
    r := readline(fromf, line, 40);
    test prompt then
      if line %equals "*" then
        break
    or if r = EOF then
      break;
    write(tof, "%s\n", line) }
  resultis 1 }

let help() be
{ writestr(tty, "commands:\n");
  writestr(tty, "  exit\n");
  writestr(tty, "  help             just prints this again\n");
  writestr(tty, "  format <name>    format the disc, give it that name\n");
  writestr(tty, "  info             display information mostly from superblock\n");
  writestr(tty, "  dir              list all directory entries\n");
  writestr(tty, "  copy <a> <b>     create file b as a copy of file a\n");
  writestr(tty, "  del <a>          delete file, only for disc files\n");
  writestr(tty, "filenames:\n");
  writestr(tty, "  d/name           is a disc file\n");
  writestr(tty, "  t/name           is a tape file\n");
  writestr(tty, "  tty/             keyboard or monitor (note the / to prevent ambiguity)\n");
  writestr(tty, "  (other)          assumed to be a disc file\n") }

let start() be
{ init();
  command_loop := thiscall();
  help();
  while true do
  { let command = vec(20), fname = vec(20), fromfile = vec(20), input = vec(40), r;
    error_reason := nil;
    writestr(tty, "> ");
    readstr(tty, command, 20);

    test command %equals "exit" then
    { dismount_disc();
      break }

    or test command %equals "help" then
      help()

    or test command %equals "info" then
      show_superblock()

    or test command %equals "dir" then
      show_root_directory()

    or test command %equals "format" then
    { readstr(tty, fname, 20);
      r := format_disc(fname);
      test r >= 0 then
        write(tty, "%s formatted with %d blocks\n", fname, r)
      or
        write(tty, "error %d: %s\n", r, error_names ! -r) }

    or test command %equals "copy" then
    { let outf, inf, r;
      readstr(tty, fromfile, 20);
      readstr(tty, fname, 20);
      inf := open(fromfile, 'r');
      if inf < 0 then
      { perror(inf, "opening (r)", fromfile);
        loop }
      outf := open(fname, 'w');
      if outf < 0 then
      { perror(outf, "opening (w)", fname);
        loop }
        
      r := create_file_from_file(outf, inf);
      
      if r < 0 then
        perror(inf, fromfile, fname);
      r := close(outf);
      if r < 0 then
        perror(inf, "closing (r)", fromfile);
      r := close(inf);
      if r < 0 then
        perror(inf, "closing (w)", fname) }

    or test command %equals "del" then
    { let r;
      readstr(tty, fname, 20);
      r := delete_file(fname);
      if r < 0 then
        perror("delete", fname) }
        
    or
    { abandon_input_line(tty);
      write(tty, "%s???\n", command) } } }