%option "-low-nonstandard-nocheck-nodiag-nostack-noline"

%constinteger min elapsed time = 30 000;  ! msecs

%include "MOOSE:MOUSE.INC"

%externalstring(127)%fnspec itos(%integer i, n)

%externalroutinespec fsys initialise
%externalroutinespec create partition table(%integername p size)
%externalroutinespec initialise partition(%integer partition, size,
                                                   index, index size)

%externalroutinespec cache enquiry(%integername crh, crm, cwc, cwm)
%externalroutinespec disc stats(%integername r, w, h)

%systemroutinespec phex(%integer i)
%systemroutinespec phex2(%integer i)

%include "FSYS.INC"
%externalintegerfnspec fsys get full ID(%integer partial, %integername full)

%recordformat block fm(%bytearray b(0 : 511))

%routine fill block(%record(block fm)%name b, %integer x)
   %integer i
      b_b(i) = (i + x) & 255 %for i = 0, 1, 511
%end

%routine test block(%record(block fm)%name b, %integer x)
   %integer i
      %for i = 0, 1, 511 %cycle
         %if b_b(i) # (i + x) & 255 %start
            printstring("Mismatch: expecting ");  write((i + x) & 255, 0)
            printstring(", got ");  write(b_b(i), 0);  newline
            %return
         %finish
      %repeat
%end

%ownintegerarray tokens(1 : 32) = 0(*)
%ownintegerarray IDs   (1 : 32) = 0(*)

%routine check token(%integer token, us)
   %integer i
      %for i = 1, 1, 32 %cycle
         %if i # us %start
            %if tokens(i) = token %start
               write(us, 0)
               printstring(": token ");  write(token, 0)
               printstring(" already owned by ");  write(i, 0)
               newline
               %cycle;  %repeat
            %finish
         %finish
      %repeat
%end

%routine check ID(%integer ID, us)
   %integer i
      %for i = 1, 1, 32 %cycle
         %if i # us %start
            %if IDs(i) = ID %start
               write(us, 0)
               printstring(": ID ");  phex(ID)
               printstring(" already owned by ");  write(i, 0)
               newline
               %cycle;  %repeat
            %finish
         %finish
      %repeat
%end

%owninteger process = 0
%ownrecord(semaphore fm) sem = 0

%owninteger last time = 0

%routine put2(%integer x)
   %integer t, u
      t = x // 10;  u = x - 10 * t
      print symbol(t + '0')
      print symbol(u + '0')
%end

%routine show time(%integer msecs)
   %integer d, h, m, s
      s = (msecs & 16_7FFFFFFF) // 1000
      m = s // 60;  s = s - 60 * m
      h = m // 60;  m = m - 60 * h
      d = h // 24
      %if d # 0 %start
         h = h - 24 * d
         write(d, 0);  space
      %finish
      put2(h);  print symbol(':')
      put2(m);  print symbol(':')
      put2(s)
%end

%ownrecord(semaphore fm) stats semaphore = 0

%routine show stats
   %integer crh, crm, cwc, cwm
   %owninteger last crh = 0, last crm = 0, last cwc = 0, last cwm = 0
   %integer reads, writes, HW
   %owninteger last reads = 0, last writes = 0
   %integer now, elapsed time, total
      semaphore wait(stats semaphore)
      now = real time
      elapsed time = now - last time
      %if elapsed time < min elapsed time %start
         signal semaphore(stats semaphore)
         %return
      %finish
      last time = now
      signal semaphore(stats semaphore)
      cache enquiry(crh, crm, cwc, cwm)
      disc stats(reads, writes, HW)
      total = crh - last crh + %c
              crm - last crm + %c
              cwc - last cwc + %c
              cwm - last cwm
      show time(now);  spaces(2)
      write(crh - last crh, 0);  printstring(" CRH, ")
      write(crm - last crm, 0);  printstring(" CRM, ")
      write(cwc - last cwc, 0);  printstring(" CWC, ")
      write(cwm - last cwm, 0);  printstring(" CWM, ")
      last cwm = cwm;  last cwc = cwc
      last crm = crm;  last crh = crh
      write(HW, 0);  printstring(" HW, ")
      write(reads - last reads, 0);  printstring(" R, ")
      write(writes - last writes, 0);  printstring(" W, ")
      !! total = reads - last reads + writes - last writes
      last reads = reads;  last writes = writes
      !! write(total, 0);  printstring(" T, ")
      write(1000 * total // elapsed time, 0)
      printstring(" t/s")
      newline
%end

%owninteger test = 0

%routine do test
   %record(block fm) b = 0
   %integer i, token, ID, status, bytes, us, pn, n, size, flags, our test
   %string(31) doing
    ! %on 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 %start
    !    write(us, 0)
    !    printstring(": Event ");  write(event_event, 0)
    !    printstring(", sub ");  write(event_sub, 0)
    !    printstring(", extra ");  write(event_extra, 0)
    !    printstring(", message """);  printstring(event_message)
    !    printstring(""", doing """);  printstring(doing)
    !    print symbol('"');  newline
    !    %cycle;  %repeat
    ! %finish
      open input(0, ":T");  select input(0)
      open output(0, ":T");  select output(0)
      fsys initialise
      semaphore wait(sem)
      process = process + 1
      us = process
      signal semaphore(sem)
      n = (37 * us) & 127 + 49
      write(us, 0);  printstring(" starting, size ");  write(n, 0);  newline
      pn = rem(us, 3) + 1
      %cycle
         semaphore wait(sem)
         test = test + 1;  our test = test
         signal semaphore(sem)
         doing = "create"
         status = fsys create file(nil, "test_" . itos(us, 0),
                                   pn, 0, n, 0, 0, ID)
         doing = ""
         %if status # 0 %start
            write(us, 0);  write(our test, 1)
            printstring(": Create: ");  write(status, 0)
            newline
            %cycle;  %repeat
         %finish
         !! write(us, 0);  write(our test, 1)
         !! printstring(": Created as ");  phex(ID);  newline
         check ID(ID, us);  IDs(us) = ID
         doing = "open modify"
         status = fsys open file(nil, ID, modify access, 0, token, size, flags)
         doing = ""
         %if status # 0 %start
            write(us, 0);  write(our test, 1)
            printstring(": Open: ");  phex(ID);  space;  write(status, 0)
            newline
            %cycle;  %repeat
         %finish
         !! write(us, 0);  write(our test, 1)
         !! printstring(": Opened ");  phex(ID)
         !! printstring(" as ");  write(token, 0);  newline
         check token(token, us);  tokens(us) = token
         %for i = 0, 1, n - 1 %cycle
            fill block(b, i + ID + us + our test + n)
            doing = "write"
            status = fsys write file block(nil, token, i, 512, b)
            doing = ""
            %if status # 0 %start
               write(us, 0);  write(our test, 1)
               printstring(": Write: ");  write(token, 0);  space
               phex(ID);  space;  write(status, 0)
               newline
               %cycle;  %repeat
            %finish
         %repeat
         doing = "close (modify)"
         tokens(us) = 0
         status = fsys close file(nil, token, auto truncate flag)
         doing = ""
         %if status # 0 %start
            write(us, 0);  write(our test, 1)
            printstring(": Close: ");  write(token, 0);  space
            phex(ID);  space;  write(status, 0)
            newline
            %cycle;  %repeat
         %finish
         token = 0
         !! write(us, 0);  write(our test, 1)
         !! printstring(": Closed ");  phex(ID)
         !! printstring(", reopening");  newline
         doing = "open read"
         status = fsys open file(nil, ID, read access, 0, token, size, flags)
         doing = ""
         %if status # 0 %start
            write(us, 0);  write(our test, 1)
            printstring(": Open: ");  phex(ID);  space;  write(status, 0)
            newline
            %cycle;  %repeat
         %finish
         !! write(us, 0);  write(our test, 1)
         !! printstring(": Reopened ");  phex(ID)
         !! printstring(" as ");  write(token, 0);  newline
         size = size // 512
         %if size # n %start
            write(us, 0);  write(our test, 1)
            printstring(": expecting size ");  write(n, 0)
            printstring(", got ");  write(size, 0)
            newline
         %finish
         check token(token, us);  tokens(us) = token
         %for i = 0, 1, n - 1 %cycle
            bytes = -1
            doing = "read"
            status = fsys read file block(nil, token, i, bytes, b)
            doing = ""
            %if status # 0 %or bytes # 512 %start
               write(us, 0);  write(our test, 1)
               printstring(": Read: ");  write(token, 0);  space
               phex(ID);  space;  write(status, 0)
               printstring(", ");  write(bytes, 0)
               newline
               tokens(us) = 0
               i = fsys close file(nil, token, 0)
               IDs(us) = 0
               i = fsys delete file(nil, ID)
               %cycle;  %repeat
            %finish
            test block(b, i + ID + us + our test + n)
         %repeat
         doing = "close (read)"
         tokens(us) = 0
         status = fsys close file(nil, token, 0)
         doing = ""
         %if status # 0 %start
            write(us, 0);  write(our test, 1)
            printstring(": Close: ");  write(token, 0);  space
            phex(ID);  space;  write(status, 0)
            newline
            %cycle;  %repeat
         %finish
         !! write(us, 0);  write(our test, 1)
         !! printstring(": Closed ");  phex(ID)
         !! printstring(" again, deleting");  newline
         doing = "delete"
         IDs(us) = 0
         status = fsys delete file(nil, ID)
         doing = ""
         %if status # 0 %start
            write(us, 0);  write(our test, 1)
            printstring(": Delete: ");  phex(ID);  space;  write(status, 0)
            newline
         %finish
         !! write(us, 0);  write(our test, 1)
         !! printstring(": All done with ");  phex(ID);  newline
         show stats
      %repeat
%end

%begin
   %record(semaphore fm) forever
   %record(process fm)%name child
   %integer i, procs, status, full, p size, i size
   %label x
      open input(0, ":T");  select input(0)
      open output(0, ":T");  select output(0)
      setup semaphore(sem)
      setup semaphore(stats semaphore)
      %cycle
         prompt("Processes: ");  read(procs)
         %if procs < 0 %start
            prompt("Are you sure you want to initialise the disc? ")
            read symbol(procs) %until procs > ' '
            %if procs = 'Y' %or procs = 'y' %start
               create partition table(p size)
               printstring("Partition size is ")
               write(p size, 0);  newline
               prompt("Index file size: ")
               read(i size) %until 0 < i size <= p size // 2
               initialise partition(1, p size, (p size - i size) // 2, i size)
               initialise partition(2, p size, (p size - i size) // 2, i size)
               initialise partition(3, p size, (p size - i size) // 2, i size)
            %finish
            skip symbol %while next symbol # NL;  skip symbol
         %else %if procs > 0
            %exit
         %finish
      %repeat
      fsys initialise
      status = fsys get full ID(16_01000002, full)
      %if status = 0 %start
         printstring("Full ID of 16_01000002 is ");  phex(full)
         newline
      %else
         printstring("Couldn't find full ID for 16_01000002: ")
         write(status, 0);  newline
      %finish
      signal semaphore(stats semaphore)
      signal semaphore(sem)
      child == create process(8192, addr(x), 2, nil) %for i = 1, 1, procs
      last time = real time
      setup semaphore(forever)
      semaphore wait(forever)
x:    do test
%end %of %program