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

%include "GDMR_H:FSysAcc.Inc"
%include "GDMR_H:FSys.Inc"
%include "GDMR_H:Dir.Inc"

%systemroutinespec phex(%integer i)

%externalintegerfnspec disc size(%integername size)
%externalintegerfnspec disc read(%integer block, %bytename buffer)
%externalintegerfnspec disc read N(%integer block, blocks, %bytename buffer)
%externalintegerfnspec disc write(%integer block, %bytename buffer)
%externalintegerfnspec partition read(%integer block, %record(*)%name buffer)
%externalintegerfnspec partition write(%integer block, %record(*)%name buffer)
%externalroutinespec   partition enquiry(%integername v, s, h)

! Disc tables

%recordformat header partition fm(%integer start, finish, lp, flags,
                                  %string(15) name)
%recordformat disc header fm((%integer checksum,
                              %record(header partition fm)%array p(1 : 15)) %c
                         %or %integerarray x(1 : 128))

%constinteger hazarded   flag = 1
%constinteger structured flag = 2
%constinteger valid      flag = 4


%constinteger boot size = 4096
%constinteger header size = 32;  ! Min.

%routine create partition table(%integername p size)
   %record(header partition fm)%name p
   %record(disc header fm) disc header = 0
   %integer i, c, status, size, last end
      status = disc size(size)
      printstring("Disc size is ");  write(size, 0);  newline
      p size = ((size - boot size - header size) // 3) & (\ 31)

      p == disc header_p(1)
      p_start = 0;  p_finish = boot size - 1  { assume start at 0 }
      p_lp = 4;  p_name = "Boot"
      p_flags = hazarded flag ! valid flag
      last end = p_finish + 1

      p == disc header_p(2)
      p_start = last end;  p_finish = p_start + p size - 1
      p_lp = 2;  p_name = "U0"
      p_flags = hazarded flag ! structured flag ! valid flag
      last end = p_finish + 1

      p == disc header_p(3)
      p_start = last end;  p_finish = p_start + p size - 1
      p_lp = 1;  p_name = "System"
      p_flags = hazarded flag ! structured flag ! valid flag
      last end = p_finish + 1

      p == disc header_p(4)
      p_start = last end;  p_finish = p_start + p size - 1
      p_lp = 3;  p_name = "U1"
      p_flags = hazarded flag ! structured flag ! valid flag
      last end = p_finish + 1

      p == disc header_p(5)
      p_start = last end;  p_finish = size - 1
      p_lp = 5;  p_name = "Header"
      p_flags = valid flag
      c = 0
      c <- c + disc header_x(i) %for i = 2, 1, 128
      disc header_checksum = -c
      status = disc write(size - 1, byteinteger(addr(disc header)))
      printstring("Partition tables initialised at ")
      write(size - 1, 0);  printstring(", status = ")
      write(status, 0);  newline
%end

%recordformat partition header fm((%integer checksum, size, index %c
                                  ) %or %integerarray x(1 : 128))

%recordformat header access fm(%integer ID, access)

! Protections from FSys.Inc ....

%constinteger new owner access = read   access ! modify   access ! %c
                                 append access ! exchange access ! %c
                                 link   access ! control  access
%constinteger new local access = read access
%constinteger new world access = no access

%constinteger system ID = -1

! Flag word definitions
!constinteger directory    file  = 16_0001
%constinteger overlapping  file  = 16_0002
%constinteger bad block    file  = 16_0004

%constinteger backup   required  = 16_0100
%constinteger archive  required  = 16_0200

! Extent definition
%recordformat extent fm(%integer start, size)


! Header definition
%constinteger non extent size = 8 + 2 + 2 + 12 + 8 + %c
                                12 + 12 + 16 + 4 + 2 + 2

%constinteger extent limit = (512 - non extent size) // 8
%constinteger access table size = extent limit;  ! One grows up, other down

%recordformat file header fm((%integer checksum, ID,
                              %short header refcount,
                              %short flags,
                              %integer owner, owner access, supervisor,
                              %integer world access, local access,
                              %integer creator, static ID, audit ID,
                              %integer created, modified, accessed,
                              %string(15) creation name,
                              %integer blocks used,
                              %short bytes in last block,
                              %short extent limit,
                              ( %record(header access fm)%array %c
                                    access(1 : access table size) %c
                            %or %record(extent fm)%array %c
                                    extent(1 : extent limit)) %c
                             ) %or %integerarray x(1 : 128))

! ID fields:
!     directory | partition | sequence | index
!       2 bits  |   6 bits  |  8 bits  | 16 bits

%constinteger index      part = 16_0000FFFF
%constinteger file ID    part = 16_00FFFFFF
%constinteger partition  part = 16_3F000000
!constinteger partition shift = 24
%constinteger file ID    mask = 16_3FFFFFFF

%constinteger file sequence increment = 16_00010000


%routine set header checksum(%record(file header fm)%name h)
   %integer i, c
      c = 0
      c <- c + h_x(i) %for i = 2, 1, 128
      h_checksum = -c
%end

%routine initialise partition(%integer partition, size, index, index size)
   %record(partition header fm) ph
   %record(file header fm) fh
   %integer status, i, c, px
      printstring("Initialise partition ");  write(partition, 0)
      print symbol(':');  write(size, 1);  write(index, 1)
      write(index size, 1);  newline
      px = partition << partition shift
      ph = 0
      ph_size = size
      ph_index = index
      c = 0
      c <- c + ph_x(i) %for i = 2, 1, 128
      ph_checksum = -c
      status = partition write(px, ph)
      %if status < 0 %start
         printstring("Error initialising partition header");  newline
         %return
      %finish
      fh = 0
      fh_ID = 16_00010001
      fh_header refcount = 1
      fh_flags = backup required
      fh_owner = system ID;  fh_owner access = read access ! modify access
      fh_world access = read access;  ! ??
      fh_local access = fh_world access
      fh_creation name = "Index file"
      fh_blocks used = index size
      fh_bytes in last block = 512
      fh_extent limit = extent limit
      fh_extent(extent limit)_start = index
      fh_extent(extent limit)_size = index size
      set header checksum(fh)
      status = partition write(px ! index, fh)
      %if status < 0 %start
         printstring("Failed to write index file header")
         newline
         %return
      %finish
      fh = 0
      %for i = 1, 1, index size - 1 %cycle
         status = partition write(px ! index + i, fh)
         %if status < 0 %start
            printstring("Failed to clear file header ")
            write(i, 0)
            newline
            %return
         %finish
      %repeat
%end


%owninteger root directory ID = 16_41010002

%routine lookup root
   %record(path fm) path
   %string(255) textual translation
   %integer status, parent, translated
      path_next == nil;  path_version = 0
      path_text = "";  path_key == path_text
      status = directory lookup(nil, path, translated, root directory ID,
                                parent, textual translation)
      printstring("Lookup root: status ");  write(status, 0)
      newline
      printstring("Root ID is ");  phex(root directory ID);  newline
%end

%routine do create directory
   %record(path fm) path
   %string(255) textual translation
   %integer partition, translated, parent, status
      path_next == nil;  path_version = 0
      prompt("Directory name: ");  read(path_text);  path_key == path_text
      prompt("Partition: ");  read(partition)
      status = create directory(nil, path, partition, 0,
                                translated, parent, textual translation)
      printstring("Create status ");  write(status, 0);  newline
%end

%routine convert metacharacters(%string(*)%name s)
   %integer i
   %bytename ch
      %return %if s = ""
      %for i = 1, 1, length(s) %cycle
         ch == charno(s, i)
         %if ch = ':' %start
            ch = 0
         %else %if ch = '>' %and i = 1
            ch = 1
         %finish
      %repeat
%end

%routine do define redirector
   %string(255) key, translation
   %integer local, status
      prompt("Name: ");  read(key)
      prompt("Translation: ");  read(translation)
      convert metacharacters(translation)
      prompt("Local, External: ")
      %cycle
         read symbol(local)
         %if local = 'L' %or local = 'l' %start
            status = directory insert local(nil, root directory ID,
                                            key, translation)
            %exit
         %else %if local = 'E' %or local = 'e'
            status = directory insert external(nil, root directory ID,
                                               key, translation)
            %exit
         %finish
      %repeat
      printstring("Insert status ");  write(status, 0);  newline
%end


%begin
   %integer OK, p size, i size, OP
      open input(0, ":T");  select input(0)
      open output(0, ":T");  select output(0)
      prompt("Initialise, Define: ")
      %cycle
         read symbol(OP)
         %if OP = 'I' %start
            prompt("Are you sure you want to initialise the disc? ")
            read symbol(OK) %until OK > ' '
            %if OK = 'Y' %or OK = '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)
               printstring("Now reboot your machine and run this program again")
               newline
               %cycle;  %repeat
            %finish
         %else %if op = 'D' %or op = 'd'
            lookup root
            %cycle
               prompt("Create directory, Define redrector: ")
               %cycle
                  read symbol(OP)
                  %if op = 'C' %or op = 'c' %start
                     do create directory
                     %exit
                  %else %if OP = 'D' %or op = 'd'
                     do define redirector
                     %exit
                  %finish
               %repeat
            %repeat
         %finish
      %repeat
%end %of %program
