MODULE main;

(*$L-*)

MODULE unixcalls;

DEFINE
	open, creat, close, read, write, seek;



PROCEDURE open (
	filename :	ARRAY integer OF char;
	mode :		UNIV integer
) :			integer;

BEGIN
	open := -1;

code('	tst	(sp)+');	{ fix sp because of := }
code('	mov	sp,r3');	{ save stack pointer }
code('	mov	6(r3),r0');	{ high file name index }
code('	sub	10(r3),r0');	{ minus low file name index }
code('	inc	r0');		{ no of chars in file name }

code('	mov	r0,r1');	{ make room on stack ... }
code('	inc	r1');		{ ... bump once for null ... }
code('	inc	r1');		{ ... once in case it is odd ... }
code('	bic	$1,r1');	{ ... make sure it is even ... }
code('	sub	r1,sp');	{ ... and voila }

code('	mov	4(r3),r1');	{ addr of filename[0] }
code('	add	10(r3),r1');	{ first char of filename }
code('	mov	sp,r2');	{ r2 is destination }
code('1:movb	(r1)+,(r2)+');	{ move from filename to buffer }
code('	sob	r0,1b');
code('	clrb	(r2)');		{ and tack on null }

code('  mov     sp,0f');        { address of file name }
code('	mov	2(r3),0f+2');	{ mode }
code('	sys	0;	 9f');	{ indirect system call }
code('	bec	2f');		{ branch if no error }
code('	mov	$-1,r0');	{ return -1 if error }
code('2:mov     r3,sp');        { restore stack pointer }
code('	rts	pc');		{ and return }

code('.data');
code('9:sys	open; 0:0; 0');
code('.text');

END open;



PROCEDURE creat (
	filename :	ARRAY integer OF char;
	mode :          UNIV bits
) :			integer;

BEGIN
	creat := -1;

code('	tst	(sp)+');	{ fix sp because of := }
code('	mov	sp,r3');	{ save stack pointer }
code('	mov	6(r3),r0');	{ high file name index }
code('	sub	10(r3),r0');	{ minus low file name index }
code('	inc	r0');		{ no of chars in file name }

code('	mov	r0,r1');	{ make room on stack ... }
code('	inc	r1');		{ ... bump once for null ... }
code('	inc	r1');		{ ... once in case it is odd ... }
code('	bic	$1,r1');	{ ... make sure it is even ... }
code('	sub	r1,sp');	{ ... and voila }

code('	mov	4(r3),r1');	{ addr of filename[0] }
code('	add	10(r3),r1');	{ first char of filename }
code('	mov	sp,r2');	{ r2 is destination }
code('1:movb	(r1)+,(r2)+');	{ move from filename to buffer }
code('	sob	r0,1b');
code('	clrb	(r2)');		{ and tack on null }

code('  mov     sp,0f');        { address of file name }
code('	mov	2(r3),0f+2');	{ mode }
code('	sys	0;	 9f');	{ indirect system call }
code('	bec	2f');		{ branch if no error }
code('	mov	$-1,r0');	{ return -1 if error }
code('2:mov     r3,sp');        { restore stack pointer }
code('	rts	pc');		{ and return }

code('.data');
code('9:sys     creat; 0:0; 0');
code('.text');

END creat;



PROCEDURE close (
	fd :		UNIV integer
);

BEGIN

code('	mov	2(sp),r0');	{ put file escriptor in r0 }
code('	sys	close');
code('	rts	pc');

END close;



PROCEDURE seek (
	fd :		UNIV integer;
	offset :	UNIV integer;
	ptrname :	UNIV integer
);

BEGIN

code('	mov	2(sp),0f+2');	{ ptrname }
code('	mov	4(sp),0f');	{ offset }
code('	mov	6(sp),r0');	{ file descriptor }
code('	sys	0; 9f');	{ indirect system call }
code('	bec	2f');		{ braanch if no error }
code('	mov	$-1,r0');	{ return error value }
code('	rts	pc');		
code('2:clr	r0');		{ return normal value }
code('	rts	pc');

code('.data');
code('9:sys	seek; 0:0; 0');
code('.text');

END seek;



PROCEDURE read (
	fd :		UNIV integer;
	addr :		UNIV integer;
	size :		UNIV integer
) :			integer;

BEGIN
	read := -1;

code('	tst	(sp)+');	{ fix sp }

code('	mov	2(sp),0f+2');	{ number of bytes }
code('	mov	4(sp),0f');	{ address of buffer }
code('	mov	6(sp),r0');	{ file descriptor }
code('	sys	0; 9f');	{ indirect system call }
code('	bec	1f');		{ branch if no error }
code('	mov	$-1,r0');	{ return error value }
code('1:rts	pc');

code('.data');
code('9:sys	read; 0:0; 0');
code('.text');

END read;



PROCEDURE write (
	fd :		UNIV integer;
	addr :		UNIV integer;
	size :		UNIV integer
) :			integer;

BEGIN
	write := -1;

code('	tst	(sp)+');	{ fix sp }

code('	mov	2(sp),0f+2');	{ number of bytes }
code('	mov	4(sp),0f');	{ address of buffer }
code('	mov	6(sp),r0');	{ file descriptor }
code('	sys	0; 9f');	{ indirect system call }
code('	bec	1f');		{ branch if no error }
code('	mov	$-1,r0');	{ return error value }
code('1:rts	pc');

code('.data');
code('9:sys	write; 0:0; 0');
code('.text');

END write;



END unixcalls;

MODULE misc;

DEFINE
	exit, move, clear, signore;



PROCEDURE exit;

BEGIN

code('	sys	exit');

END exit;



PROCEDURE move (
	from :		UNIV integer;
	to :		UNIV integer;
	count :		UNIV integer

);

BEGIN

code('	mov	2(sp),r0');	{ byte count of data to move }
code('	beq	2f');		{ skip move if it is 0 }
code('	mov	4(sp),r2');	{ destination to r2 }
code('	mov	6(sp),r1');	{ source to r1 }
code('1:movb	(r1)+,(r2)+');	{ move a byte }
code('	sob	r0,1b');	{ ... and count }
code('2:');			{ all done }

END move;



PROCEDURE clear(
	addr:		UNIV integer;
	count:		UNIV integer
);

BEGIN

code('	mov	2(sp),r0');	{ count to r0 }
code('	beq	2f');		{ skip clr code if zero }
code('	mov	4(sp),r1');	{ address to r1 }
code('1:clrb	(r1)+');	{ clear a byte }
code('	sob	r0,1b');	{ ... and count }
code('2:');			{ all done }

END clear;



PROCEDURE signore(
	sig:                    UNIV cardinal);

BEGIN

code('  mov     2(sp),1f');     { move signal num to syscall }
code('  sys     0;0f');         { indirect syscall }
code('  rts     pc');

code('.data');
code('0:sys     signal; 1:0; 1');
code('.text');

END signore;



END misc;

MODULE chario;

DEFINE
	stdin, stdout, errout,
	input, output,
	putch, flush, puts,
	getch, gets,
	err;

USE
	open, read, write, close, exit;

CONST
	stdin = 0;
	stdout = 1;
	errout = 2;
	bufsize = 512;

TYPE
	iobuf = RECORD
		fd :		integer;
		nin :		integer;
		ngot :		integer;
		data :		ARRAY 0 : bufsize - 1 OF char;
	END;

VAR
	in, out :		iobuf;

PROCEDURE input (
	file :			integer
);

BEGIN
	WITH in DO
		fd := file;
		nin := 0;
		ngot := 0;
	END;
END input;

PROCEDURE flush;

VAR
	x :			integer;

BEGIN
	WITH out DO
		IF nin > 0 THEN
			x := write(fd, adr(data), nin);
			nin := 0;
		END;
	END;
END flush;

PROCEDURE output (
	file :			integer
);

BEGIN
	flush;

	WITH out DO
		fd := file;
		nin := 0;
		ngot := 0;
	END;
END output;

PROCEDURE putch (
	ch :		UNIV char
);

VAR
	x :		integer;

BEGIN
	WITH out DO
		data[nin] := ch;
		inc(nin);

		IF nin >= bufsize THEN
			flush;
		END;
	END;
END putch;

PROCEDURE puts (
	str :		ARRAY integer OF char
);

VAR
	c :		char;
	i, h :		integer;

BEGIN
	i := low(str);
	h := high(str);

	WHILE (i <= h) AND (str[i] <> 0C) DO
		c := str[i];

		IF (c = '\') AND (i < h) THEN
			inc(i);
			c := str[i];
			CASE c OF
			'n':
				BEGIN c := 12C END;
			't':
				BEGIN c := 11C END
			END;
		END;

		putch(c);
		inc(i);
	END;
END puts;

PROCEDURE getch :		char;

VAR
	n :		integer;

BEGIN
	WITH in DO
		IF ngot >= nin THEN
			n := read(fd, adr(data), size(data));
			IF n <= 0 THEN
				nin := 0;
			ELSE
				nin := n;
			END;
			ngot := 0;
		END;

		IF ngot < nin THEN
			getch := data[ngot];
			inc(ngot);
		ELSE
			getch := 0C;
		END;
	END;
END getch;

PROCEDURE gets (
	VAR buf :	ARRAY integer OF char
);

VAR
	c :		char;
	i :		integer;

BEGIN
	i := low(buf);
	REPEAT
		c := getch;
		IF c = 12C THEN
			c := 0C;
		END;

		IF i <= high(buf) THEN
			buf[i] := c;
			inc(i);
		END;
	UNTIL c = 0C;
END gets;

PROCEDURE err(
	emsg:		ARRAY integer OF char
);

BEGIN
	flush;
	output(errout);
	puts(emsg);
	puts('\n');
	flush;
	exit;
END err;

	{ initialization }

BEGIN
	WITH in DO
		fd := stdin;
		nin := 0;
		ngot := 0;
	END;

	WITH out DO
		fd := stdout;
		nin := 0;
		ngot := 0;
	END;
END chario;

MODULE string;

DEFINE
	cmp, copy;

PROCEDURE cmp (
	str1, str2:	ARRAY integer OF char
):			boolean;

VAR
	i1, i2:		integer;
	e1, e2:		boolean;

BEGIN
	i1 := low(str1);
	i2 := low(str2);

	LOOP
		e1 := (i1 > high(str1)) OR (str1[i1] = 0C);
		e2 := (i2 > high(str2)) OR (str2[i2] = 0C);

		WHEN e1 AND e2 DO
			cmp := true;
			EXIT;

		WHEN e1 OR e2 OR (str1[i1] <> str2[i2]) DO
			cmp := false;
			EXIT;

		inc(i1);
		inc(i2);
	END;
END cmp;

PROCEDURE copy (
	str1:		ARRAY integer OF char;
	VAR str2:	ARRAY integer OF char
);

VAR
	i1, i2:		integer;

BEGIN
	i1 := low(str1);
	i2 := low(str2);

	WHILE (i1 <= high(str1)) AND (i2 <= high(str2)) DO
		str2[i2] := str1[i1];
		inc(i1);
		inc(i2);
	END;

	IF i2 <= high(str2) THEN
		str2[i2] := 0C;
	END;
END copy;

END string;


(* ===========================================================================

COPYRIGHT:  1979, by Ford Aerospace and Communications Corp.
ADDRESS:    Ford Aerospace and Communications Corp.
            Western Development Laboratories
            3939 Fabian Way
            Palo Alto, California 94303
            Attention: Software Technology Dept.
            Mail Stop: V02 

CPCI:  KSOS Kernel

NAME:

	     KERNEL GLOBAL DECLARATIONS -- NON-ALLOCATING
	
HISTORY:
  AUTHOR:   Richard Neely, Luke Dion
  VERSION:  10.32.1.1 of 11/21/80
  MODULE TYPE: 

=========================================================================== *)

CONST KERnadWhat = '@(#)KERnad.mod	10.32.1.1';

CONST
    max_virt_addr   = 177777B;  (*2^16 - 1*)
    (*table sizes*)
	open_file_limit =     15 ;  (*olt open files per process*)
	open_seg_limit  =     15 ;  (*olt segments per process*)
	top_page_group  =      7 ;  (*olt page reg groups per proc-dom-space*)
	top_gen_reg     =      5 ;  (*olt no. of general registers*)
	top_flo_reg     =      5 ;  (*olt no. of floating registers*)
	mes_limit	=	11;	(* number of chars-1 in message *)
	user_sem_limit  =       320;    (* number of user semaphores    *)

TYPE
	(* ============== Miscellaneous ================ *)

	seg_index       = integer;

	seg_des         = integer;

	openDescriptor  = integer;

	selector        = bits;

	(* ============== Fundamental Types ================= *)

	byte            = char;

	bits32          = ARRAY 0:1 OF bits;    (* 32-bit bits *)

	cardinal32      = ARRAY 0:1 OF cardinal; (* 32-bit unsigned *)

	phys_addr       = cardinal;

	exceptionType   = cardinal;	(* exceptions at kernel interface *)

	nsp_type        = byte;         (* name space partition *)

CONST
	    null_nsp    = char(0);      (* null *)
	    extent_nsp  = char(1);      (* EXTENTS *)
	    terminal_nsp= char(2);      (* TERMINALS *)
	    device_nsp  = char(3);      (* DEVICES *)
	    process_nsp = char(4);      (* PROCESSES *)
	    segment_nsp = char(5);      (* SEGMENTS *)
	    subtype_nsp = char(6);      (* SUBTYPES *)
	    kernel_nsp  = char(7);      (* Kernel namespace *)
	    same_nsp    = char(128);    (* used in UNIX directories only *)
	    low_file_nsp = char(129);   (* first nsp for mounted file system*)
	    high_file_nsp= char(255);   (* last nsp for mounted file system *)

TYPE

	seid            = RECORD                (* secure entity identifier *)
			  nsp     : nsp_type;       (* name space *)
			  uniq_id0: byte;           (* unique ID *)
			  uniq_id1: cardinal;
			  END;

	priv_struct     = bits32;               (* set of privileges *)

	priv_names      = (                     (*names of privileges*)
			  privFileUpdateStatus,  privLink,
			  privLockSeg,           privModifyPriv,
			  privMount,             privSetLevel,
			  privStickySeg,         privSetPath,
			  privViolSimpSecurity,  privViolStarSecurity,
			  privViolSimpIntegrity, privViolStarIntegrity,
			  privViolDiscrAccess,   privRealizeExecPermission,
			  privSignal,            privWalkPTable,
			  privHalt,              privKernelCall,
			  privViolCompartments,  privSetComm,
			  privImmigrate,         privViolTranquility
			  );

	(* ============== TII Construction ================= *)

	discr_access	= bits;			(* discretionary access *)

	security_cat_type       = byte;   (* security categories (half byte) *)

	integrity_cat_type      = byte;   (* integrity categories (half byte) *)

	compart_set     = bits32;        (* set of security compartments *)

	tii_struct      = RECORD
			  security_category     : security_cat_type;
			  integrity_category    : integrity_cat_type;
			  security_compart      : compart_set;
			  owner                 : cardinal;
			  group                 : cardinal;
			  da                    : discr_access;
			  tii_priv              : priv_struct;
			  END;

	(* ============== Virtual Memory ================= *)

	domain_type     = (null_domain,kernel_domain,supervisor_domain,user_domain);


	mem_type        = (null_space,d_space,i_space);

	virt_addr       = cardinal;

	virt_loc        = RECORD               (* virtual location *)
			  domain        : domain_type;
			  space         : mem_type;
			  address       : virt_addr;
			  END;

	p_block         = RECORD
			  location      : virt_loc;
			  size          : cardinal;
			  END;


	(** IPC Kernel interface structure **)

	msg_struct = ARRAY 0:mes_limit OF char; (* IPC message data *)

	ipc_return = RECORD
			sender  : seid;
			message : msg_struct;
		     END;

	ipc_block = RECORD
			ipc_ptr	: integer;
			ipc_mes	: ipc_return;
		    END;

CONST
	(*
	 * Event type codes for pseudo interrupt IPC's
	 *	(To be placed in the first byte of the
	 *		message field.)
	 *)

	null_event		= 0C;
	memerr_event		= 1C;
	bpt_event		= 2C;
	iot_event		= 3C;
	cpuerror_event		= 4C;
	illinst_event		= 5C;
	mm_event		= 6C;
	fltpnt_event		= 7C;
	ttoggle_event		= 10C;
	talarm_event		= 11C;
	emulcall_event		= 12C;
	iocomplete_event	= 13C;


CONST
    (* bits for discretionary access in TII *)
	setuid		   = 10;
	setgid		   = 9;
	ownerRead          = 8;
	ownerWrite         = 7;
	ownerExecute       = 6;
	groupRead          = 5;
	groupWrite         = 4;
	groupExecute       = 3;
	allRead            = 2;
	allWrite           = 1;
	allExecute         = 0;
    (* bits for access mode in POST *)
	readAcc            = ownerRead;
	writeAcc           = ownerWrite;
	executeAcc         = ownerExecute;
    (* null objects *)
	null_boolean       = false;
	null_bits          = [];
	null_char          = 0C;
	null_integer       = 0;
	null_cardinal      = 0;

	null_byte          = 0C;
	null_seg_des       = -1;
	null_seg_index     = -1;
	null_security_cat  = 0C;
	null_integrity_cat = 0C;

	null_virt_loc      = virt_loc(null_domain,null_space,0);

	no_index           = -1;
	null_seid          = seid(null_nsp,0C,null_cardinal);
	null_bits32        = bits32([],[]);
	null_tii_struct    = tii_struct(0C,0C,bits32([],[]),
					0,0,[],bits32([],[]));
    (* other *)
	readOnly           = [readAcc];
	writeOnly	   = [writeAcc];


VAR type_cond: bits;
CONST
    type_all		= 0;
    type_param		= 1;
    type_param_nw	= 2;
    type_Kcall		= 3;
    type_Kcall_nw	= 4;
    type_gate		= 5;
    type_swap		= 6;
    type_sch		= 7;
    type_pse		= 8;

(*
    CPC:  KIO
    CP:   all
	
    B5 Specs: ???
    C Specs: ???
    AUTHOR:   J. Nagle
    VERSION:  1.14 of 6/17/80        (c) 1979 FACC

    Definitions from the I/O system which are required elsewhere in the
    Kernel.
    All definitions of I/O structures needed for kernel calls are here.

*)

		 (* @(#)KIOnad.mod	1.14  WHAT(I) level indicator *)

(*
	CPP definitions required for the assert mechanism
*)


TYPE
    asyncId = cardinal;                 (* user's asynchronous identifier *)

    absAddress = cardinal32;

    relAddress = virt_addr;

    fBlockNumber = cardinal32;		(* block number within file *)

    ioStatus = RECORD                   (* I/O status of operation *)
	       devIndep : exceptionType;(* device-independent part *)
	       devDep   : bits;         (* device-dependent part *)
	       END;

    ioFunction = (                      (* functions for K_device_function *)
		READ
	       ,WRITE
	       ,SETEOMCHARS
	       ,REWIND
	       ,UNLOAD
	       ,WRITEMARK
	       ,SETDENSITY
	       ,SETTERMMODES1		(* non-security-related *)
	       ,SETTERMMODES2		(* security-related *)
	       ,GETTERMMODES
	       ,SETFILESIZE
	       ,ERASEFILE
	       ,VOLUMEVALID
	       ,VOLUMEINVALID
	       ,INPUTWAIT
	       ,SETPATH
	       );

    transfer_direction = (NO_TRANSFER, INWARD, OUTWARD); (* for p_blocks *)

    transfer_block = RECORD                 (* p_block for I/O transfer *)
		    blk: p_block;           (* where *)
		    dir: transfer_direction;(* which way *)
		    abs: absAddress;        (* absolute address for internal *)
		    END;

    setOfOpenModes = RECORD             (* used on K_open requests *)
	       read: boolean;           (* if open for reading *)
	       write: boolean;          (* if open for writing *)
	       exclusive_read: boolean; (* read exclusively *)
	       exclusive_write: boolean;(* write exclusively *)
	       END;

    file_stat_block = RECORD            (* file status  *)
	f_size          : cardinal32;   (* file size    *)
	subtype         : seid;         (* file subtype *)
	time_last_mod   : cardinal32;   (* time of last mod *)
	open_at_crash   : boolean       (* if open at crash *)
    END;
(*
	Terminal mode bits for SETTERMMODES1 and GETTERMMODES

	To use the values in this list, coerce into cardinal and
	use as a bit subscript of the "blockNo" or "errs.devDep"
	argument to K_device_function.
*)
terminal_mode_bits =
		(break_on_all_characters,
		 suppress_echo,
		 suppress_echo_of_break_character);
(*
	Text of Asynchronous I/O Completion Message
*)
    ioCompletionMessage = RECORD
	sender: seid;				(* seid of sender *)
	event_type: char;			(* ***TEMP*** *)
	filler1: char;				(* align for next word *)
	stat:  ioStatus;			(* status *)      
	byteCount: cardinal;			(* length of transfer *)
	async: asyncId;				(* requestor's marker *)
	filler2: ARRAY 1:2 OF char;		(* filler to 16 bytes *)
	END;

(*
	Disk Format Definitions

	This file, IOform, gives the constants used in defining the
	structures of both extents and file systems.  The file
	IOFform contains additional definitions needed for file
	systems, and the file IOEform contains additional definitions
	applicable only to extents.

	These structures are for use by trusted software only.

HISTORY:
  AUTHOR:   J. Nagle
  VERSION:  1.3 of 4/9/80
*)
				(* @(#)IOform.mod	1.3  WHAT(I) identification string *)
CONST
    BLKSZ = 512;
    SLOTSPERBLOCK = 5;
    SLOTSIZE = 102;    (* size of a slot in extent system space *)
    SLOTBLKFILLSZ = 2; (* bytes needed to fill a block containing slots to BLKSZ *)
    SLOTCHKSUM = 31415; (* standard checksum for all slot types and extent records *)

(*
	Revision level of structures.  Change when making an incompatible
	change to the file system design.
	This value appears in "revLevel" in the mount item.
*)
    REVLEV = 2;				(* revision 2: bit mapped allocation *)



TYPE
labelName = ARRAY 1:20 OF char;         (* used to hold names of packs,
					   extents, and file systems *)
vBlockNumber = cardinal32;              (* Absolute block number on disk*)
mBlockNumber = cardinal32;              (* Block number within extent *)
itemKind = (mountKind,freeKind,jNodeKind,indirectKind,allocKind,
	    reservedKind, extentKind);(* Kind of control item *)

subType =       seid;                   (* file subtype *)
timeStamp =     cardinal32;             (* includes time and date *)


security     =  RECORD                  (* security-related information *)
		tii: tii_struct;       (* type independent information *)
		sub: subType;           (* subtype *)
		END;

(*
	Data Structures For KSOS Disk Packs

	The data structures defined here give the layout of the control
	information of the areas on a disk.  These data structures
	are used by both the KSOS kernel  and the KSOS
	NKSR file recovery, initialization, dump, and restore utilities.

	These structures are for use by trusted software only.

HISTORY:
  AUTHOR:   J. Nagle
  VERSION:  1.5 of 7/11/80
*)
			(* @(#)IOEform.mod	1.5 WHAT(I) identification string *)
CONST
    DISKEXTENTS = 35;		(* max number of extents per disk *)

    (* extent number of system extents *)
    LEVELZEROBOOTEXT = 1;
    LEVELONEBOOTEXT =  2;
    EXTMAPEXT       =  3;
    SECURITYEXT     =  4;

    (* starting locations of system extents on pack *)
    LEVELZEROBOOT = 0;
    UNUSED =        1;
    EXTMAP =        5;
    SECURITYMAP =  12;
    LEVELONEBOOT = 20;
    USERDISK =     36;

    (*  Fillers for index slot items.  All must be exactly 102 bytes long. *)
    EXTFILLSZ =   43;



TYPE


(* ========================================================================= *)
(*          This structure appears in the disk extent map                    *)
(*          and defines the max access level and location of each extent     *)
(*          on the pack. This item is the same size as the kernel items.     *)
(* ========================================================================= *)

extentItem= RECORD
		checkSum: cardinal;     (* record checksum*)
		kind: itemKind;         (* always extentKind *)
		extno : cardinal;       (* name space partition of this extent*)
		label: labelName;       (*name of extent *)
		extSecurity: security;  (* the maximum access level for this extent*)
		firstblock: vBlockNumber; (* absolute block number of first block of this extent*)
		lastblock: vBlockNumber;(* absolute block number of last block *)
		extSize: mBlockNumber;  (* size of extent in blocks *)
		filler: ARRAY 1:EXTFILLSZ OF char; (* fill to 64 bytes *)
	    END;


(*
	Data Structures For KSOS File Systems

	The data structures defined here give the layout of the control
	information of the file system in an extent.  These data structures
	are used by both the KSOS kernel file system and the KSOS
	NKSR file recovery, initialization, dump, and restore utilities.

	These structures are for use by trusted software only.

HISTORY:
  AUTHOR:   J. Nagle
  VERSION:  1.2 of 1/22/80
*)
					(* @(#)IOFform.mod	1.2 WHAT(I) identification string *)
CONST
    UKOFFSET = 4;      (* value which added to a UNIX inode will give the
			  corresponding KSOS jnode *)


    (*  Fillers for index slot items.  All must be exactly 102 bytes long. *)
    EMPTYFILLSZ = 98;
    JNODEFILLSZ = 4;
    INDEXFILLSZ = 3;
    MNTFILLSZ =   36;



TYPE
slotNumber   = cardinal32;              (* Item number within extent *)
treeNumber   = cardinal;                (* Item number in file tree *)
mapNumber    = cardinal;		(* which alloc slot amongst slots *)
fileCond =     (FILESAFE,               (* File OK and not open for writing *)
		FILEWRITING,            (* File open for write *)
		FILEDAMAGED,            (* File was FILEWRITING at recovery *)
		FILEDESTROYED,          (* File was fouled up at recovery *)
		FILERESLOCK);           (* File restore locked *)





(* ========================================================================= *)
(*          Structures which appear in the kernel's part of a file system    *)
(*          Collectively, we call these 'items'.                             *)
(*          These are all the same size, with fill as required.              *)
(* ========================================================================= *)

CONST
    maxIndirect = 9;                    (* max link per any item *)
    maxDirectInJnode = 5;               (* max link in a jNode *)
    maxDirectInIndirect = 12;           (* max link in an Index Item *)
    allocMapSize= 96 DIV 2;             (* words per alloc map - fills map *)
    allocMapMax = allocMapSize - 1;     (* high word in alloc map *)
    mapCapacity = allocMapSize * 16;	(* bits represented by one map *)
    nullPointer = 65535;                (* this value in the hi order word of a*)
					(* direct or indirect pointer indicates that *)
					(* pointer is not valid *)
					(* this is a full null pointer *)
    nullPointer32 = cardinal32(nullPointer,nullPointer);
					(* locations of some fixed items *)
    mountLocation    = slotNumber(0,0); (* the mount item *)
    badBlockLocation = slotNumber(0,1); (* the file of bad blocks jNode *)
    freeLocation     = slotNumber(0,2); (* free file jNode *)
					(* 3 : RESERVED for future expansion*)
					(* 4 : RESERVED for future expansion*)
    firstUserSlot = slotNumber(0,5);	(* lowest dynamically allocated slot *)


TYPE
emptySlot = RECORD                      (* Unallocated block *)
		checkSum: cardinal;     (* [2] item checksum *)
		kind: itemKind;         (* [1] always freeKind *)
		fill: ARRAY 1 : EMPTYFILLSZ  OF char; (* fill area, always null *)
	    END;

reservedSlot = RECORD                       (* Reseved for future system use *)
		checkSum: cardinal;         (* [2] item checksum *)
		kind: itemKind;             (* [1] always reservedKind *)
		fill: ARRAY 1 : EMPTYFILLSZ  OF char; (* fill area, always null *)
	    END;

allocMap  = ARRAY 0:allocMapMax OF bits;(* one map item - part of allocSlot *)

allocSlot = RECORD                      (* bit map for allocation *)
		checkSum: cardinal;     (* item checksum *)
		kind: itemKind;         (* always allocKind *)
	        self: mapNumber;	(* own position *)
			(* NOTE: self = nullPointer after unrecovered crash*)
		map:  allocMap;         (* allocation bit map *)
	    END;

jNode = RECORD
		checkSum:cardinal;      (* item checksum *)
		kind: itemKind;         (* always jNodeKind *)
					(* pointers to indirect items *)
		indirectTable: ARRAY 1 : maxIndirect OF slotNumber;
					(* pointers to data blocks *)
		directTable:   ARRAY 1 : maxDirectInJnode OF mBlockNumber;
		cond: fileCond;         (* for recovery *)
		rights: security;       (* access control information *)
		self: slotNumber;       (* location of self (redundant) *)
		highBlock: fBlockNumber;(* Maximum block number in file *)
		trailCount: cardinal;	(* bytes to ignore in last block *)
		linkCount: cardinal;    (* Use count *)
		textLastMod: timeStamp; (* Time of last modification *)
		fill: ARRAY 1 : JNODEFILLSZ  OF char; (* fill area, always null *)
	END;

indirectItem = RECORD                   (* Describes blocks from one file *)
		checkSum: cardinal;     (* item checksum *)
		kind: itemKind;         (* always indirectKind *)
		indirectTable: ARRAY 1 : maxIndirect OF slotNumber;
					(* must match jNode to this point *)
		directTable:   ARRAY 1 : maxDirectInIndirect OF mBlockNumber;
		homeJnode: slotNumber;  (* redundant *)
		parent: slotNumber;     (* back link to indirect item or jNode *)
		treeN: treeNumber;      (* position in tree of this item *)
		fill: ARRAY 1 : INDEXFILLSZ  OF char; (* fill area, always null *)
	    END;

mountInfo = RECORD                      (* subpart of mountItem *)
		slotsDefined: cardinal32;(* Slots defined in this fs *)
		blocksDefined:cardinal32;(* Data blocks defined in this fs *)
		firstAllocItem: slotNumber; (* slot of first allocItem *)
		firstUserBlock: mBlockNumber;(* Beginning of user area *)
		tii: tii_struct;        (* Max levels and owner of this fs *)
		mounted: boolean;       (* TRUE if currently mounted *)
	    END;

mountItem = RECORD                      (* Describes one file system *)
		checkSum: cardinal;     (* item checksum *)
		kind: itemKind;         (* always mountKind *)
		revLevel: cardinal;	(* revision level of design *)
		mInfo: mountInfo;       (* counts, as above *)
		sysNo: cardinal;        (* number of system on which file system was initialized *)
		initDate: timeStamp;    (* date-time file system was initialized *)
		label: labelName;       (* name of this file system *)
		fill: ARRAY 1 : MNTFILLSZ OF char; (* fill area, always null *)
	    END;




(* this file was inspired by /kr/sunix/nksr/NSO/UDM/udm.h *)

CONST
	SIZE_OF_DIR_NAME	= 14;
	SIZE_OF_DIR_ENTRY	= SIZE_OF_DIR_NAME + 4;
	PATH_SIZE		= 512;
	NUMBER_OF_ENTRIES	= 28;
	DIR_FILL_SIZE		= 8;

	DIR_SUBTYPE		= seid(subtype_nsp, char(100), cardinal(0));
	ROOT			= seid(same_nsp, char(0), cardinal(5));
	UDM_OWNER		= 2;
	UDM_GROUP		= 1;

TYPE
	D_entry = RECORD
		SEID :		seid;
		name :		ARRAY 1:SIZE_OF_DIR_NAME OF char;
	END;

	dir_buf = RECORD
		dir_entry :	ARRAY 1:NUMBER_OF_ENTRIES OF D_entry;
		fill :		ARRAY 1:DIR_FILL_SIZE OF char;
	END;

(*
	Initial Values for File Items
*)
CONST

    initialIndirectItem = indirectItem (0, indirectKind,
		    [* maxIndirect *] (cardinal32(65535, 65535)),
		    [* maxDirectInIndirect *] (cardinal32(65535, 65535)),
		    slotNumber(0,0), slotNumber(0,0),cardinal(0),
		    [*INDEXFILLSZ*](0C));

(*
	initial jNode   --   prototype used by K_create
*)
initialJnode = jNode(
	0,				(* checksum *)
	jNodeKind,			(* kind *)
	[* maxIndirect *] slotNumber(nullPointer,nullPointer),
	[* maxDirectInJnode *] mBlockNumber(nullPointer,nullPointer),
	FILEWRITING,			(* initial state *)
	security(			(* rights *)
	    tii_struct(0C,0C,bits32([],[]),nullPointer,nullPointer,[],bits32([],[])),
	    seid(null_nsp,0C,0)),	(* subtype seid *)
	slotNumber(0,0),		(* self *)
	fBlockNumber(0,0),		(* high block *)
	0,				(* trailing bytes to ignore *)
	0,				(* link count *)
	timeStamp(0,0),			(* text last mod *)
	[* JNODEFILLSZ *] 0C);		(* filler *)
(*
	initial free item  --  used when releasing slots
*)
    initialFreeItem = emptySlot (0, freeKind, [* EMPTYFILLSZ*](0C));


MODULE c32Arith;
DEFINE
  addc32,                 (* 32-bit unsigned add *)
  subc32,                 (* 32-bit unsigned subtract*)
  makec32,                (* generate 32-bit from 16-bit cardinal *)
  cmpc32,                 (* compare two 32-bit cardinals *)
  divc32,                 (* divide a 32-bit by a 16-bit with 32-bit result*)
  mulc32,                 (* multiply a 32-bit by a 16-bit giving a 32-bit result *)
  incc32,                 (* Add a cardinal to a cardinal32 *)
  decc32;                 (* Subtract a cardinal from a cardinal32 *)

USE
  cardinal32;

CONST
  c32Arith_WHAT    = '@(#)c32.mod	1.1{0C}';

VAR
  c32error: boolean;





PROCEDURE makec32 (
	a, b :		UNIV cardinal;
	VAR c :		UNIV cardinal32
);
BEGIN
	c[0] := a; c[1] := b
END makec32;



PROCEDURE addc32 (
	a :		UNIV cardinal32;
	VAR b :		UNIV cardinal32
);

BEGIN
	c32error := false;
	inc(b[1], a[1]);
	IF b[1] < a[1] THEN inc(b[0]) END;
	inc(b[0], a[0]);
	IF b[0] < a[0] THEN c32error := true END
END addc32;


PROCEDURE subc32 (
	a :		UNIV cardinal32;
	VAR b :		UNIV cardinal32
);

BEGIN
	c32error := false;
	IF b[0] < a[0] THEN c32error := true END;
	dec(b[0], a[0]);
	IF b[1] < a[1] THEN
		IF b[0] = 0 THEN c32error := true END;
		dec(b[0])
	END;
	dec(b[1], a[1])
END subc32;


PROCEDURE cmpc32 (
	a, b :		UNIV cardinal32
) :			integer;

VAR
	x, y:		cardinal;
BEGIN
	IF a[0] = b[0] THEN
		x := a[1];
		y := b[1];
	ELSE
		x := a[0];
		y := b[0];
	END;

	IF x > y THEN
		cmpc32 := 1;
	ELSIF x < y THEN
		cmpc32 := -1;
	ELSE
		cmpc32 := 0;
	END;
END cmpc32;



PROCEDURE divcode (
	dividend :	cardinal32;
	divisor :	cardinal;
	VAR quotient :	cardinal32;
	VAR remainder :	cardinal
);

BEGIN
       code ('    mov  10(sp),r3  ');   (* get address of dividend *)
       code ('    mov  (r3),r1    ');   (* hi order part to low order dividend register*)
       code ('    clr  r0         ');   (* clear hi order dividend register*)
       code ('    div  6(sp),r0   ');   (* division of first two byte of dividend *)
       code ('    mov  r0,*4(sp)  ');   (* quotient of this divide is hi order result *)
       code ('    mov  r1,r0      ');   (* remainder to hi order dividend register*)
       code ('    mov  2(r3),r1   ');   (* lo order part to low order dividend register*)
       code ('    ashc $-8,r0     ');   (* shift right 8 leaves remainder in high order
					   byte of r1 and 3rd byte of the dividend in the
					   low order byte *)
       code ('    div  6(sp),r0   ');   (* division of 3rd byte of dividend *)
       code ('    swab r0         ');   (* quotient to high byte of register*)
       code ('    mov  4(sp),r2   ');   (* get address of result variable   *)
       code ('    mov  r0,2(r2)   ');   (* quotient of this divide 3rd byte of result*)
       code ('    mov  r1,r0      ');   (* remainder to hi order dividend register*)
       code ('    mov  2(r3),r1   ');   (* lo order word of dividend to low order register*)
       code ('    swab r1         ');   (* 4th byte of dividend to high byte of register*)
       code ('    ashc $-8,r0     ');   (* shift right 8 leaves remainder in hi order byte
					   and 4th byte of dividend in low order byte *)
       code ('    div  6(sp),r0   ');   (* division of 4th byte of dividend *)
       code ('    movb r0,2(r2)   ');   (* quotient of this divide 4th byte of result*)
       code ('    mov  r1,*2(sp)  ');   (* remainder to remainder *)
END divcode;


PROCEDURE divc32 (
	a :		cardinal32;
	b :		UNIV cardinal;
	VAR quotient :	cardinal32;
	VAR remainder :	UNIV cardinal
);

VAR
	dividend :	cardinal32;
	divisor :	cardinal;

BEGIN
    dividend := a;      (*make sure constant params remain constant*)
    divisor := b;
    IF (divisor = 0) OR (divisor > 32767) THEN  (* attempt to divide by 0*)
	c32error := true;
    ELSIF divisor = 1 THEN               (* divide by 1 is special *)
	quotient := dividend;
	remainder := 0;
    ELSE
	divcode (dividend, divisor, quotient, remainder);
    END;
END divc32;



PROCEDURE mulc32 (
	a :		UNIV cardinal32;
	b :		UNIV cardinal;
	VAR c :		UNIV cardinal32
);

BEGIN
	c32error := false;
	code('	mov	6(sp),r3	');
	code('	mov	2(sp),r2	');
	code('	mov	2(r3),r0	');
	code('	mul	4(sp),r0	');
	code('	tst	2(r3)		');
	code('	bpl	1f		');
	code('	add	2(r3),r0	');
	code('1:	tst	4(sp)		');
	code('	bpl	2f		');
	code('	add	4(sp),r0	');
	code('2:	mov	r0,(r2)+	');
	code('	mov	r1,(r2)		');
	code('	mov	(r3),r0		');
	code('	mul	4(sp),r0	');
	code('	add	r1,-(r2)	');
	code('	tst	r0		');
	code('	beq	3f		');
	c32error := true;
	code('3:				')
END mulc32;




PROCEDURE incc32 (
	VAR a :		UNIV cardinal32;
	b :		UNIV cardinal
);

BEGIN
	c32error := false;

	inc(a[1], b);
	IF a[1] < b THEN
		inc(a[0]);
		IF a[0] = 0 THEN c32error := true END
	END
END incc32;


PROCEDURE decc32 (
	VAR a :		UNIV cardinal32;
	b :		UNIV cardinal
);

BEGIN
	c32error := false;

	IF a[1] < b THEN
		IF a[0] = 0 THEN c32error := true END;
		dec(a[0]);
	END;

	dec(a[1], b);
END decc32;



END c32Arith;

MODULE convio;

DEFINE
	puti, putc, putc32,
	geti, getc, getc32;

USE
	getch, putch,
	cardinal32, makec32, mulc32, divc32, incc32;

CONST
	zero32 = cardinal32(0,0);

PROCEDURE puti (
	x, base:	UNIV integer
);

VAR
	buf :		ARRAY 0:9 OF char;
	i, b :		integer;

BEGIN
	IF x < 0 THEN
		putch('-');
		i := -x;
	ELSE
		i := x;
	END;

	b := 0;

	REPEAT
		buf[b] := char(i MOD base + integer('0'));
		i := i / base;
		inc(b);
	UNTIL i = 0;

	REPEAT
		dec(b);
		putch(buf[b]);
	UNTIL b = 0;
END puti;

PROCEDURE putc32 (
	x:		UNIV cardinal32;
	base:		UNIV integer
);

VAR
	b, r:		integer;
	c, q:		cardinal32;
	buf:		ARRAY 0:31 OF char;

BEGIN
	b := low(buf);
	c := x;
	REPEAT
		divc32(c, base, q, r);
		buf[b] := char(integer('0') + r);
		c := q;
		inc(b);
	UNTIL (c[0] = 0) AND (c[1] = 0);

	REPEAT
		dec(b);
		putch(buf[b]);
	UNTIL b <= low(buf);
END putc32;

PROCEDURE putc (
	x:		UNIV cardinal;
	base:		UNIV integer
);

VAR
	x32:		cardinal32;

BEGIN
	makec32(0, x, x32);
	putc32(x32, base);
END putc;

PROCEDURE geti:		integer;

VAR
	neg:		boolean;
	c:		char;
	base, i:	integer;

BEGIN
	c := getch;

	IF c = '-' THEN
		neg := true;
		c := getch;
	ELSE
		neg := false;
	END;

	IF (c = '0') OR (c = 'O') OR (c = 'o') THEN
		base := 8;
		c := getch;
	ELSIF (c = 'B') OR (c = 'b') THEN
		base := 2;
		c := getch;
	ELSE
		base := 10;
	END;

	i := 0;

	LOOP
		IF (c >= '0') AND (c <= '9') THEN
			i := i * base + integer(c) - integer('0');
		END;

		WHEN c = 12C EXIT;

		c := getch;
	END;

	IF neg THEN
		geti := -i;
	ELSE
		geti := i;
	END;
END geti;

PROCEDURE getc32 (
	VAR x:		UNIV cardinal32
);

VAR
	c:		char;
	base:		cardinal;
	prod:		cardinal32;

BEGIN
	x := zero32;

	c := getch;

	IF (c = '0') OR (c = 'o') OR (c = 'O') THEN
		base := 8;
		c := getch;
	ELSIF (c = 'B') OR (c = 'b') THEN
		base := 2;
		c := getch;
	ELSE
		base := 10;
	END;

	LOOP
		IF (c >= '0') AND (c <= '9') THEN
			mulc32(x, base, prod);
			incc32(prod, integer(c) - integer('0'));
			x := prod;
		END;

		WHEN c = 12C EXIT;

		c := getch;
	END;
END getc32;

PROCEDURE getc:		cardinal;

VAR
	x32:		cardinal32;

BEGIN
	getc32(x32);
	getc := x32[1];
END getc;

END convio;

MODULE bio;

DEFINE
	bflush, bfind, bclose, Btype;

USE
	clear,
	puts, putc,
	seek, read, write, close;

CONST
	BLOCKSIZE =		512;
	CACHESIZE =		16;
	NULLIX =		0;

TYPE
	cacheIndex =		cardinal;
	Btype =			(Bread, Bupdate, Bwrite);

	cacheEntry = RECORD
		next:		cacheIndex;
		prev:		cacheIndex;
		fd:		integer;
		bno:		cardinal;
		dirty:		boolean;
		data:		ARRAY 0:BLOCKSIZE-1 OF char;
	END;

VAR
	head, tail:		cacheIndex;
	cache:			ARRAY 1:CACHESIZE OF cacheEntry;

PROCEDURE bflush(
	f:		integer
);

VAR
	i:		cacheIndex;
	x:		integer;

BEGIN
	i := low(cache);
	WHILE i <= high(cache) DO
		WITH cache[i] DO
			IF f = fd THEN
				IF dirty THEN
					seek(fd, bno, 3);
					x := write(fd, adr(data), size(data));
					dirty := false;
				END;
				fd := -1;
			END;
		END;

		inc(i);
	END;
END bflush;

PROCEDURE bfind(
	f:		integer;
	b:		cardinal;
	upd:		Btype
):			cardinal;

VAR
	found:		cardinal;
	i:		cacheIndex;
	x:		integer;

BEGIN
	found := 0;

	i := head;
	LOOP
		WHEN i = NULLIX EXIT;

		WHEN (cache[i].fd = f)
		  AND (cache[i].bno = b) DO
		EXIT;

		i := cache[i].next;
	END;

	IF i = NULLIX THEN
		i := tail;

		WITH cache[i] DO
			IF dirty THEN
				seek(fd, bno, 3);
				x := write(fd, adr(data), size(data));

				IF x <> size(data) THEN
					puts('bio: can''t write fd ');
					putc(fd, 10);
					puts(' block ');
					putc(bno, 10);
					puts('\n');
				END;

				dirty := false;
			END;

			fd := f;
			bno := b;

			IF upd = Bwrite THEN
				clear(adr(data), size(data));
			ELSE
				seek(f, b, 3);
				x := read(f, adr(data), size(data));

				IF x <> size(data) THEN
					puts('bio: can''t read fd ');
					putc(fd, 10);
					puts(' block ');
					putc(bno, 10);
					puts('\n');
				END;
			END;
		END;
	END;

	WITH cache[i] DO
		IF prev <> NULLIX THEN
			cache[prev].next := next;
			IF next <> NULLIX THEN
				cache[next].prev := prev;
			ELSE
				tail := prev;
			END;

			next := head;
			prev := cache[head].prev;
			cache[head].prev := i;
			head := i;
		END;

		IF upd <> Bread THEN
			dirty := true;
		END;
		found := adr(data);
	END;

	bfind := found;
END bfind;

PROCEDURE bclose(
	f:		integer
);

VAR
	i:		cacheIndex;

BEGIN
	bflush(f);
	close(f);
END bclose;

(*
 * initialization
 *)

VAR
	i:		cacheIndex;

BEGIN
	i := low(cache);
	WHILE i <= high(cache) DO
		WITH cache[i] DO
			next := i + 1;
			prev := i - 1;
			fd := -1;
			dirty := false;
		END;

		inc(i);
	END;

	head := low(cache);
	tail := high(cache);

	cache[head].prev := NULLIX;
	cache[tail].next := NULLIX;
END bio;

MODULE extio;

DEFINE
	extentDescriptor,
	calcCheck,
	openx, closex, flushx,
	findx, readx, writex,
	readj, writej,
	findb, readb, writeb,
	setmap, freeb, allocb;

USE
	{ consts }
	SLOTSPERBLOCK, EXTMAP, errout,
	SLOTSIZE, SLOTCHKSUM, SLOTBLKFILLSZ,
	nullPointer, nullPointer32, mountLocation,
	mapCapacity,

	{ types }
	cardinal32,
	vBlockNumber, mBlockNumber, slotNumber,
	extentItem, jNode, mountItem, itemKind,
	allocSlot, allocMap, mapNumber,
	Btype,

	{ procs }
	addc32, subc32,
	mulc32, divc32,
	incc32, cmpc32, makec32,
	open, bfind, bclose, bflush,
	output, putc32, puts, flush,
	signore, move, err, copy, exit;

CONST
	BLOCKSIZE =	512;
	bitsPerWord =	16;
	allOnes =	[0:15];

TYPE
	sumArea = ARRAY 0:((SLOTSIZE-1) DIV 2) OF cardinal;

	jBlock = RECORD
		jbufs:		ARRAY 0:SLOTSPERBLOCK-1 OF jNode;
		filler:		ARRAY 0:SLOTBLKFILLSZ-1 OF char;
	END;

	extentDescriptor = cardinal;
	extentEntry = RECORD
		openCount:	cardinal;
		devName:	ARRAY 0:31 OF char;
		extNo:		cardinal;
		fileDes:	integer;
		eItem:		extentItem;
		mItem:		mountItem;
		mapNo:		mapNumber;
		mapBuf:		allocSlot;
		mapMod:		boolean;
	END;

VAR
	exttab:			ARRAY 0:4 OF extentEntry;



PROCEDURE calcCheck (
	item :		UNIV sumArea
) :			cardinal;

VAR
	i, sum :	cardinal;

BEGIN
	sum := SLOTCHKSUM;
	i := low(item) + 1;

	WHILE i <= high(item) DO
		sum := sum + item[i];
		inc(i);
	END;

	calcCheck := sum;
END calcCheck;



PROCEDURE xcheck(
	ex:		extentDescriptor
);

BEGIN
	IF (ex < low(exttab))
	  OR (ex > high(exttab))
	  OR (exttab[ex].openCount = 0) THEN
		err('bad extent');
	END;
END xcheck;



PROCEDURE findx(
	ex:		extentDescriptor;
	bno:		mBlockNumber;
	upd:		Btype
):			cardinal;

VAR
	b:		vBlockNumber;

BEGIN
	WITH exttab[ex] DO
		b := bno;
		addc32(eItem.firstblock, b);
		findx := bfind(fileDes, b[1], upd);
	END;
END findx;



PROCEDURE readx (
	ex:		extentDescriptor;
	bno:		mBlockNumber;
	VAR buf:	UNIV jBlock
);

BEGIN
	xcheck(ex);

	move(findx(ex, bno, Bread), adr(buf), size(buf));
END readx;



PROCEDURE writex(
	ex:		extentDescriptor;
	bno:		mBlockNumber;
	buf:		UNIV jBlock
);

BEGIN
	xcheck(ex);

	move(adr(buf), findx(ex, bno, Bwrite), size(buf));
END writex;



PROCEDURE findj(
	ex:		extentDescriptor;
	jn:		slotNumber;
	upd:		Btype
):			cardinal;

VAR
	b:		mBlockNumber;
	i:		cardinal;

BEGIN
	WITH exttab[ex] DO
		divc32(jn, SLOTSPERBLOCK, b, i);
		addc32(eItem.firstblock, b);
		findj := bfind(fileDes, b[1], upd) + (i * SLOTSIZE);
	END;
END findj;



PROCEDURE readj(
	ex:		extentDescriptor;
	jn:		slotNumber;
	VAR jnode:	UNIV jNode
);

BEGIN
	xcheck(ex);

	move(findj(ex, jn, Bread), adr(jnode), size(jnode));
END readj;



PROCEDURE writej(
	ex:		extentDescriptor;
	jn:		slotNumber;
	VAR jnode:	UNIV jNode
);

BEGIN
	xcheck(ex);

	jnode.checkSum := calcCheck(jnode);

	move(adr(jnode), findj(ex, jn, Bupdate), size(jnode));

	IF (jn[0] = mountLocation[0])
	  AND (jn[1] = mountLocation[1]) THEN
		move(adr(jnode), adr(exttab[ex].mItem), size(jnode));
	END;
END writej;



PROCEDURE setmap(
	ex:		extentDescriptor;
	mapn:		mapNumber
);

VAR
	slotn:		slotNumber;

BEGIN
	xcheck(ex);

	WITH exttab[ex] DO
		IF mapn <> mapNo THEN
			IF mapMod THEN
				slotn := mItem.mInfo.firstAllocItem;
				incc32(slotn, mapNo);
				writej(ex, slotn, mapBuf);
				mapMod := false;
			END;

			IF mapn <> nullPointer THEN
				slotn := mItem.mInfo.firstAllocItem;
				incc32(slotn, mapn);
				readj(ex, slotn, mapBuf);
			END;

			mapNo := mapn;
		END;
	END {WITH};
END setmap;



PROCEDURE openx (
	VAR ex:		extentDescriptor;
	devn:		ARRAY integer OF char;
	extn:		UNIV cardinal;
	mode:		integer
):			boolean;

VAR
	x, f:		integer;
	j:		cardinal;
	success:	boolean;
	jblk:		jBlock;

BEGIN
	success := true;

	ex := low(exttab);

	LOOP
		WHEN ex > high(exttab) DO
			ex := low(exttab);
			success := false;
		EXIT;

		WHEN exttab[ex].openCount = 0 EXIT;

		inc(ex);
	END;

	WITH exttab[ex] DO
		IF success THEN
			f := open(devn, mode);
			IF f < 0 THEN
				success := false;
			END;
		END;

		IF success THEN
			j := bfind(f, EXTMAP+(extn DIV SLOTSPERBLOCK), Bread);
			j := j + (extn MOD SLOTSPERBLOCK) * SLOTSIZE;
			move(j, adr(eItem), size(eItem));

			IF (eItem.kind <> extentKind)
			  OR (calcCheck(eItem) <> eItem.checkSum) THEN
				success := false;
			END;
		END;

		IF success THEN
			inc(openCount);
			copy(devn, devName);
			extNo := extn;
			fileDes := f;

			mapNo := nullPointer;
			mapMod := false;

			readj(ex, mountLocation, mItem);
		ELSE
			bclose(f);
		END;
	END;

	openx := success;
END openx;



PROCEDURE closex(
	ex:		extentDescriptor
);

BEGIN
	xcheck(ex);

	WITH exttab[ex] DO
		IF openCount = 1 THEN
			setmap(ex, nullPointer);
			bclose(fileDes);
		END;
		dec(openCount);
	END;
END closex;



PROCEDURE flushx(
	ex:		extentDescriptor
);

BEGIN
	xcheck(ex);

	WITH exttab[ex] DO
		setmap(ex, nullPointer);
		bflush(fileDes);
	END;
END flushx;



PROCEDURE findb(
	ex:		extentDescriptor;
	bno:		mBlockNumber;
	upd:		Btype
):			cardinal;

VAR
	b:		mBlockNumber;

BEGIN
	WITH exttab[ex] DO
		b := bno;
		addc32(mItem.mInfo.firstUserBlock, b);
		findb := findx(ex, b, upd);
	END;
END findb;



PROCEDURE readb (
	ex:		extentDescriptor;
	bno:		mBlockNumber;
	VAR buf:	UNIV jBlock
);

BEGIN
	move(findb(ex, bno, Bread), adr(buf), size(buf));
END readb;



PROCEDURE writeb(
	ex:		extentDescriptor;
	bno:		mBlockNumber;
	buf:		UNIV jBlock
);

BEGIN
	move(adr(buf), findb(ex, bno, Bwrite), size(buf));
END writeb;



PROCEDURE decomposeBlockNumber(
	n:		mBlockNumber;
	VAR aslot:	mapNumber;	{ which bit map }
	VAR w:		cardinal;	{ which word in bit map }
	VAR b:		cardinal	{ which bit in word }
);

VAR
	wslot:		cardinal32;
	rem:		cardinal;

BEGIN
	divc32(n, mapCapacity, wslot, rem);
	aslot := wslot[1];
	w := rem DIV bitsPerWord;
	b := rem MOD bitsPerWord;
END decomposeBlockNumber;



PROCEDURE freeb(
	ex:		extentDescriptor;
	block:		mBlockNumber
);

VAR
	aslot:		mapNumber;
	w:		cardinal;
	b:		cardinal;
	i:		cardinal;

BEGIN
	IF (block[0] <> nullPointer) OR (block[1] <> nullPointer) THEN
		decomposeBlockNumber(block, aslot, w, b);
		setmap(ex, aslot);
		WITH exttab[ex] DO
			IF NOT mapBuf.map[w][b] THEN
				puts('freeing non-allocated block\n');
			END;
			mapBuf.map[w][b] := false;
			mapMod := true;
		END {WITH};
	END;
END freeb;



PROCEDURE allocb(
	ex:		extentDescriptor;
	VAR block:	mBlockNumber
);

VAR
	success:	boolean;
	word:		bits;		{ selected word of bit map }
	w:		cardinal;	{ word position }
	start:		mapNumber;	{ map number at which search started }
	bpos:		cardinal;	{ bit position in single map }
	aslot:		mapNumber;	{ which map }
	aslot32:	cardinal32;
	b:		cardinal;	{ which bit in word }
	mapMax:		mapNumber;

BEGIN
	WITH exttab[ex] DO
		(*
		 * figure out how many map items
		 *)

		aslot32 := mItem.mInfo.slotsDefined;
		subc32(mItem.mInfo.firstAllocItem, aslot32);
		mapMax := aslot32[1] - 1;

		start := mapNo;
		IF start = nullPointer THEN
			start := 0;
		END;

		aslot := start;
		success := false;
		LOOP
			setmap(ex, aslot);
			w := 0;
			LOOP
				word := mapBuf.map[w];
				IF word <> allOnes THEN
					b := 0;
					WHILE word[b] DO
						inc(b);
					END;
					bpos := w * 16 + b;
					makec32(0, aslot, aslot32);
					mulc32(aslot32, mapCapacity, block);
					incc32(block, bpos);
					success := cmpc32(block,
					  mItem.mInfo.blocksDefined) < 0;
				END;

				WHEN success DO
					mapBuf.map[w][b] := true;
					mapMod := true;
				EXIT;

				inc(w);

				WHEN w > high(mapBuf.map) EXIT;
			END;

			WHEN success DO EXIT;

			inc(aslot);
			IF aslot > mapMax THEN
				aslot := 0;
			END;

			WHEN aslot = start DO
				block := nullPointer32;
			EXIT;
		END;
	END {WITH};
END allocb;



BEGIN
	signore(1);
	signore(2);
END extio;

MODULE flio;

DEFINE
	fileDescriptor,
	freej, allocj,
	creatf, openf, closef,
	seekf, freef, readf, writef;

USE
	puts, putc, putc32,
	{ consts }
	SLOTSPERBLOCK, EXTMAP, mountLocation, errout,
	nullPointer, nullPointer32,
	maxIndirect, maxDirectInJnode, maxDirectInIndirect,
	mountLocation, firstUserSlot,
	initialJnode, initialFreeItem, initialIndirectItem,

	{ types }
	cardinal32,
	security,
	vBlockNumber, mBlockNumber, fBlockNumber,
	fileCond,
	extentItem, jNode, mountItem, indirectItem, emptySlot,
	itemKind,
	slotNumber, treeNumber,
	Btype,
	extentDescriptor,

	{ procs }
	move,
	addc32, subc32,
	mulc32, divc32,
	incc32, decc32,
	cmpc32,
	open, close, read, write, seek,
	readj, writej,
	allocb, freeb, findb, writeb;

CONST
	BLOCKSIZE =			512;
	totalDirectInIndirect =		maxDirectInIndirect + 1;
	totalDirectInJnode =		maxDirectInJnode + 1;
	totalIndirect =			maxIndirect + 1;
	maxDepth =			7;
	zero32 =			cardinal32(0,0);


TYPE
	fileDescriptor = RECORD
		extDes:		extentDescriptor;
		jNumb:		slotNumber;
		fPtr:		cardinal32;
		fSize:		cardinal32;
		fMod:		boolean;
	END;

VAR
	zeros:			ARRAY 1:BLOCKSIZE/2 OF integer;


PROCEDURE freej(
	ex:		extentDescriptor;
	jn:		slotNumber
);

VAR
	item:		emptySlot;

BEGIN
	item := initialFreeItem;
	writej(ex, jn, item);
END freej;

PROCEDURE allocj(
	ex:		extentDescriptor;
	start:		slotNumber;
	VAR slot:	slotNumber
);

VAR
	item:		indirectItem;
	mitem:		mountItem;
	nslots:		slotNumber;

BEGIN
	slot := start;

	readj(ex, mountLocation, mitem);
	nslots := mitem.mInfo.slotsDefined;

	LOOP
		readj(ex, slot, item);
		WHEN item.kind = freeKind EXIT;

		incc32(slot, 1);

		IF cmpc32(slot, nslots) >= 0 THEN
			slot := firstUserSlot;
		END;

		WHEN (slot[0] = start[0])
		  AND (slot[1] = start[1]) DO
			slot := nullPointer32;
		EXIT;
	END {LOOP};
END allocj;

PROCEDURE freeblocks(
	ex:		extentDescriptor;
	blocks:		ARRAY cardinal OF mBlockNumber
);

VAR
	block:		mBlockNumber;
	i:		cardinal;

BEGIN
	i := low(blocks);
	WHILE i <= high(blocks) DO
		block := blocks[i];
		freeb(ex, block);
		inc(i);
	END;
END freeblocks;

PROCEDURE scrubBlocks(
	ex:		extentDescriptor;
	blocks:		ARRAY cardinal OF mBlockNumber
);

VAR
	i:		cardinal;
	block:		mBlockNumber;

BEGIN
	i := low(blocks);
	WHILE i <= high(blocks) DO
		block := blocks[i];
		IF block[0] <> nullPointer THEN
			writeb(ex, block, zeros);
		END;

		inc(i);
	END;
END scrubBlocks;

PROCEDURE relSubtrees(
	ex:		extentDescriptor;
	indirs:		ARRAY cardinal OF slotNumber;
	whose:		slotNumber
) [maxDepth];

VAR
	saveItem:	indirectItem;
	i:		cardinal;
	indir:		slotNumber;

BEGIN
	i := low(indirs);
	WHILE i <= high(indirs) DO
		indir := indirs[i];
		IF cmpc32(indir, nullPointer32) <> 0 THEN
			readj(ex, indir, saveItem);
			scrubBlocks(ex, saveItem.directTable);
			freej(ex, indir);
			freeblocks(ex, saveItem.directTable);

			(*
			 * This indirect item and its associated blocks
			 * are gone, but not the subtrees pointed to by
			 * them.  We recurse to get rid of them.
			 *)

			relSubtrees(ex, saveItem.indirectTable, whose);
		END;

		inc(i);
	END;
END relSubtrees;


PROCEDURE itemTree(
	i:		treeNumber;	{ given number of self }
	VAR parent:	treeNumber;	{ returned parent tree number }
	VAR offset:	cardinal	{ offset in parent block }
);

BEGIN
	parent := (i-1) DIV maxIndirect;
	offset := (i-1) MOD maxIndirect + 1;
END itemTree;


PROCEDURE blockTree(			{ returns tree number }
	b:		fBlockNumber;	{ block number in file }
	VAR tn:		treeNumber;	{ tree number in index tree }
	VAR offset:	cardinal	{ location in indirect item or jNode }
);

VAR
	w, wtn:		cardinal32;

BEGIN
	IF (b[0] = 0)			{ if in jNode }
	  AND (b[1] < maxDirectInJnode) THEN
		tn := 0;
		offset := b[1] + 1;
	ELSE
		w := b;
		decc32(w, maxDirectInJnode);
		divc32(w, maxDirectInIndirect, wtn, offset);
		inc(offset);
		tn := wtn[1] + 1;
	END {IF};
END blockTree;

PROCEDURE indirectI(			{ returns index to indirect pointer}
	fl:		fileDescriptor;
	i:		treeNumber;	{ tree position }
	VAR in:		slotNumber	{ location of resulting item }
) [maxDepth];

VAR
	pSlot:		slotNumber;	{ working slot number }
	parent:		treeNumber;	{ tree number of parent }
	offset:		cardinal;	{ subscript in indirectTable }
	item:		indirectItem;

BEGIN
	itemTree(i, parent, offset);
	IF parent = 0 THEN
		pSlot := fl.jNumb;
	ELSE
		indirectI(fl, parent, pSlot);
	END;

	IF pSlot[0] <> nullPointer THEN
		readj(fl.extDes, pSlot, item);
		in := item.indirectTable[offset];
	ELSE
		in := nullPointer32;
	END;
END indirectI;

PROCEDURE  setIndirectP(
	fl:		fileDescriptor;
	tn:		treeNumber;	{ tree position of indirect item }
	val:		slotNumber	{ new value of pointer }
);

	(*
	 * The tree number tn refers to the block which is at val.  It is the
	 * PARENT of this block which is to be updated.  The parent may be
	 * the jNode.  It is illegal to call this routine unless the item to
	 * be updated exists.
	 *)

VAR
	pSlot:		slotNumber;	{ slot number of parent }
	item:		indirectItem;	{ may be indirect or jnode }
	parent:		treeNumber;	{ tree number of parent }
	offset:		cardinal;	{ offset in parent of ptr to tn }

BEGIN
	WITH fl DO
		itemTree(tn, parent, offset);
		IF parent = 0 THEN		{ if parent is jNode }
			pSlot := jNumb;
		ELSE
			indirectI(fl, parent, pSlot);
		END;				{ end indirect case }

		readj(extDes, pSlot, item);
		item.indirectTable[offset] := val;
		writej(extDes, pSlot, item);
	END;
END setIndirectP;

PROCEDURE generateIndexItem(
	fl:		fileDescriptor;
	tn:		treeNumber;	{ new item location in tree }
	pSlot:		slotNumber;	{ location of parent }
	VAR iSlot:	slotNumber	{ address of returned item }
);

VAR
	item:		indirectItem;

BEGIN
	WITH fl DO
		allocj(extDes, jNumb, iSlot);
		item := initialIndirectItem;
		item.homeJnode := jNumb;
		item.parent := pSlot;
		item.treeN := tn;
		writej(extDes, iSlot, item);
	END;
END generateIndexItem;			{ end generateIndexItem }

(*
 * insureIndirectI - insure existence of a specific indirect item
 * returns the location of the item, as with indirectI, but will create
 * the item if necessary.
 *)

PROCEDURE insureIndirectI(		{ returns exception if fail }
	fl:		fileDescriptor;
	tn:		treeNumber;
	VAR iSlot:	slotNumber
) [maxDepth];

VAR
	pSlot:		slotNumber;
	pOffset:	cardinal;
	parent:		treeNumber;

BEGIN
	indirectI(fl, tn, iSlot);

	IF iSlot[0] = nullPointer THEN
		itemTree(tn, parent, pOffset);
		pSlot := fl.jNumb;
		IF parent > 0 THEN		{ if parent is indirect item }
			insureIndirectI(fl, parent, pSlot);
		END;

		{ the parent item should now exist }

		generateIndexItem(fl, tn, pSlot, iSlot);
		setIndirectP(fl, tn, iSlot);
	END;
END insureIndirectI;

(*
 * getBlockAddress - find data block of a specific file
 *)

PROCEDURE getBlockAddress(		{ returns error status }
	fl:		fileDescriptor;
	n:		fBlockNumber;
	VAR dBlock:	mBlockNumber
);

VAR
	ixKind:		itemKind;
	tn:		treeNumber;
	offset:		cardinal;
	ixSlot:		slotNumber;
	item:		indirectItem;

BEGIN
	blockTree(n, tn, offset);		{ get tree number and offset }
	IF tn <> 0 THEN			{ if indirect item must be read }
		indirectI(fl, tn, ixSlot);
	ELSE				{ if pointer is in jNode }
		ixSlot := fl.jNumb;
	END;				{ end must read indirect item }

	IF ixSlot[0] <> nullPointer THEN
		readj(fl.extDes, ixSlot, item);
		dBlock := item.directTable[offset];
	ELSE
		dBlock := nullPointer32;
	END;
END getBlockAddress;                     

(*
 * setBlockAddress - set a pointer to a data block
 *)

PROCEDURE setBlockAddress(
	fl:		fileDescriptor;
	n:		fBlockNumber;
	bp:		mBlockNumber
);

VAR
	offset:		cardinal;
	item:		indirectItem;
	iSlot:		slotNumber;
	tn:		treeNumber;

BEGIN
	WITH fl DO
		blockTree(n, tn, offset);
		IF tn = 0 THEN			{ if direct link from jNode }
			iSlot := jNumb;
		ELSE				{ if not in jNode }
			insureIndirectI(fl, tn, iSlot);
		END;				{ end indirect item case }

		readj(extDes, iSlot, item);
		item.directTable[offset] := bp;
		writej(extDes, iSlot, item);
	END;
END setBlockAddress;			{ end setBlockAddress }

PROCEDURE insureBlock(
	fl:		fileDescriptor;
	n:		fBlockNumber;		{ block number in file }
	VAR block:	mBlockNumber		{ block number in extent }
);

BEGIN
	getBlockAddress(fl, n, block);
	IF block[0] = nullPointer THEN
		allocb(fl.extDes, block);
		setBlockAddress(fl, n, block);
	END;
END insureBlock;


PROCEDURE openf(
	VAR fl:		fileDescriptor;
	ex:		extentDescriptor;
	jn:		slotNumber
):			boolean;

VAR
	jnode:		jNode;

BEGIN
	readj(ex, jn, jnode);
	IF jnode.kind <> jNodeKind THEN
		openf := false;
	ELSE
		WITH fl DO
			extDes := ex;
			jNumb := jn;
			fPtr := zero32;
			mulc32(jnode.highBlock, BLOCKSIZE, fSize);
			decc32(fSize, jnode.trailCount);
			fMod := false;
		END;
		openf := true;
	END;

END openf;

PROCEDURE creatf(
	VAR fl:		fileDescriptor;
	ex:		extentDescriptor;
	VAR jn:		slotNumber;
	info:		security
):			boolean;

VAR
	jnode:		jNode;

BEGIN
	IF jn[0] = nullPointer THEN
		allocj(ex, firstUserSlot, jn);
	END;

	IF jn[0] = nullPointer THEN
		creatf := false;
	ELSE
		jnode := initialJnode;
		WITH jnode DO
			cond := FILESAFE;
			rights := info;
			self := jn;
		END;
		writej(ex, jn, jnode);

		creatf := openf(fl, ex, jn);
	END;
END creatf;

PROCEDURE closef(
	fl:		fileDescriptor
);

VAR
	high:		fBlockNumber;
	trail:		cardinal;
	jnode:		jNode;

BEGIN
	WITH fl DO
		IF fMod THEN
			readj(extDes, jNumb, jnode);
			divc32(fSize, BLOCKSIZE, high, trail);
			IF trail > 0 THEN
				incc32(high, 1);
				trail := BLOCKSIZE - trail;
			END;

			jnode.highBlock := high;
			jnode.trailCount := trail;
			writej(extDes, jNumb, jnode);
		END;
	END;
END closef;

PROCEDURE seekf(
	VAR fl:		fileDescriptor;
	aptr:		cardinal32;
	flag:		integer
);

VAR
	ptr:		cardinal32;

BEGIN
	IF (flag MOD 6) < 3 THEN
		ptr := aptr;
	ELSE
		mulc32(aptr, BLOCKSIZE, ptr);
	END;

	WITH fl DO
		CASE flag OF
		0,3:	BEGIN
			fPtr := ptr;
			END;

		1,4:	BEGIN
			addc32(ptr, fPtr);
			END;

		2,5:	BEGIN
			fPtr := fSize;
			addc32(ptr, fPtr);
			END;

		7,10:	BEGIN
			subc32(ptr, fPtr);
			END;

		8,11:	BEGIN
			fPtr := fSize;
			subc32(ptr, fPtr);
			END
		END;
	END;
END seekf;

PROCEDURE freef(
	VAR fl:		fileDescriptor
);

VAR
	workJnode,
	saveJnode:		jNode;

BEGIN
	WITH fl DO
		readj(extDes, jNumb, workJnode);
		saveJnode := workJnode;
		scrubBlocks(extDes, saveJnode.directTable);
		workJnode.indirectTable := initialJnode.indirectTable;
		workJnode.directTable := initialJnode.directTable;
		workJnode.highBlock := fBlockNumber(0,0);
		workJnode.trailCount := 0;
		writej(extDes, jNumb, workJnode);

		(*
		 * The file now has size zero and is totally decoupled from
		 * its former data blocks and indirect items.
		 *)

		freeblocks(extDes, saveJnode.directTable);
		relSubtrees(extDes, saveJnode.indirectTable, jNumb);

		fSize := zero32;
		fPtr := zero32;
		fMod := true;
	END;
END freef;

PROCEDURE findf(
	fl:		fileDescriptor;
	rw:		Btype;
	VAR addr:	cardinal;
	VAR maxrw:	cardinal
);

VAR
	fbn:		fBlockNumber;
	xbn:		mBlockNumber;
	offset:		cardinal;
	nleft:		cardinal;
	x32:		cardinal32;

BEGIN
	WITH fl DO
		x32 := fSize;
		subc32(fPtr, x32);
		IF x32[0] = 0 THEN
			nleft := x32[1];
		ELSE
			nleft := BLOCKSIZE;
		END;

		IF (rw = Bupdate) OR (nleft > 0) THEN
			divc32(fPtr, BLOCKSIZE, fbn, offset);
			insureBlock(fl, fbn, xbn);
			IF xbn[0] = nullPointer THEN
				maxrw := 0;
			ELSIF (rw = Bupdate) AND (nleft = 0) AND (offset = 0) THEN
				addr := findb(extDes, xbn, Bwrite);
				maxrw := BLOCKSIZE;
			ELSE
				addr := findb(extDes, xbn, rw) + offset;
				maxrw := BLOCKSIZE - offset;
			END;
			IF (rw = Bread) AND (maxrw > nleft) THEN
				maxrw := nleft;
			END;
		ELSE
			maxrw := 0;
		END;
	END;
END findf;

PROCEDURE bumpf(
	VAR fl:		fileDescriptor;
	n:		cardinal
);

BEGIN
	WITH fl DO
		incc32(fPtr, n);
		IF cmpc32(fPtr, fSize) > 0 THEN
			fSize := fPtr;
			fMod := true;
		END;
	END;
END bumpf;

PROCEDURE readf(
	VAR fl:		fileDescriptor;
	abuf:		UNIV cardinal;
	asiz:		UNIV cardinal
):			integer;

VAR
	buf,
	siz,
	a,
	n:		cardinal;

BEGIN
	buf := abuf;
	siz := asiz;

	WITH fl DO
		LOOP
			WHEN siz = 0 EXIT;

			findf(fl, Bread, a, n);

			WHEN n = 0 EXIT;

			IF n > siz THEN
				n := siz;
			END;

			move(a, buf, n);
			buf := buf + n;
			siz := siz - n;

			bumpf(fl, n);
		END;

		readf := integer(asiz - siz);
	END;
END readf;

PROCEDURE writef(
	VAR fl:		fileDescriptor;
	abuf:		UNIV cardinal;
	asiz:		UNIV cardinal
):			integer;

VAR
	buf,
	siz,
	a,
	n:		cardinal;

BEGIN
	buf := abuf;
	siz := asiz;

	WITH fl DO
		LOOP
			WHEN siz = 0 EXIT;

			findf(fl, Bupdate, a, n);

			WHEN n = 0 EXIT;

			IF n > siz THEN
				n := siz;
			END;

			move(buf, a, n);
			buf := buf + n;
			siz := siz - n;

			bumpf(fl, n);
		END;

		writef := integer(asiz - siz);
	END;
END writef;

VAR
	i:		cardinal;

BEGIN
	i := low(zeros);
	WHILE i <= high(zeros) DO
		zeros[i] := 0;
		inc(i);
	END;
END flio;

MODULE dir;


DEFINE
	isdir,
	lookup;

USE
	D_entry,
	NUMBER_OF_ENTRIES,
	SIZE_OF_DIR_ENTRY,
	cardinal32,
	clear,
	closef,
	cmp,
	copy,
	dir_buf,
	extentDescriptor,
	fileDescriptor,
	firstUserSlot,
	incc32,
	jNode,
	makec32,
	mulc32,
	nullPointer,
	nullPointer32,
	null_nsp,
	openf,
	readf,
	readj,
	same_nsp,
	seekf,
	seid,
	slotNumber,
	subtype_nsp,
	writef;



CONST
	DIR_what =      '%W%{0C}';
	BLOCKSIZE =     512;



PROCEDURE split(
	name:           ARRAY integer OF char;
	VAR nam1:       ARRAY integer OF char;
	VAR nam2:       ARRAY integer OF char);

VAR
	i, j:		integer;
	c:		char;

BEGIN
	i := low(name);
	WHILE name[i] = '/' DO inc(i) END;

	j := low(nam1);
	LOOP
		c := name[i];
		WHEN (c = '/') OR (c = 0C) EXIT;
		nam1[j] := c;
		inc(i);
		inc(j);
	END;
	nam1[j] := 0C;

	WHILE name[i] = '/' DO inc(i) END;

	j := low(nam2);
	LOOP
		c := name[i];
		WHEN c = 0C EXIT;
		nam2[j] := c;
		inc(i);
		inc(j);
	END;
	nam2[j] := 0C;
END split;



PROCEDURE isdir(
	jnode:          jNode
):			boolean;

CONST
	DIR_SUBTYPE =   seid(subtype_nsp, char(100), 0);

BEGIN
	WITH jnode.rights.sub DO
		isdir := (nsp = DIR_SUBTYPE.nsp)
		  AND (uniq_id0 = DIR_SUBTYPE.uniq_id0)
		  AND (uniq_id1 = DIR_SUBTYPE.uniq_id1);
	END;
END isdir;



PROCEDURE seekdir(
	VAR df:		fileDescriptor;
	dix:		cardinal
);

VAR
	d, x:		cardinal32;

BEGIN
	makec32(0, dix DIV NUMBER_OF_ENTRIES, x);
	mulc32(x, BLOCKSIZE, d);
	incc32(d, (dix MOD NUMBER_OF_ENTRIES) * SIZE_OF_DIR_ENTRY);
	seekf(df, d, 0);
END seekdir;



PROCEDURE getdir(
	VAR df:		fileDescriptor;
	dix:		cardinal;
	VAR dent:	D_entry
):			boolean;

BEGIN
	seekdir(df, dix);
	IF readf(df, adr(dent), size(dent)) = size(dent) THEN
		getdir := true;
	ELSE
		getdir := false;
	END;
END getdir;



PROCEDURE indir(
	VAR df:		fileDescriptor;
	name:           ARRAY integer OF char;
	VAR dix:	cardinal
);

VAR
	dent:		D_entry;

BEGIN
	dix := 0;

	LOOP
		WHEN NOT getdir(df, dix, dent) DO
			dix := nullPointer;
		EXIT;

		WHEN cmp(name, dent.name) EXIT;
		inc(dix);
	END;

END indir;



PROCEDURE setdir(
	VAR df:		fileDescriptor;
	dx:		cardinal;
	dent:		D_entry
);

VAR
	bx, ix:		cardinal;
	x:		integer;
	dbuf:		dir_buf;

BEGIN
	ix := dx MOD NUMBER_OF_ENTRIES;
	bx := dx - ix;
	inc(ix, low(dbuf.dir_entry));

	seekdir(df, bx);
	x := readf(df, adr(dbuf), size(dbuf));

	IF x < size(dbuf) THEN
		IF x < 0 THEN
			x := 0;
		END;

		clear(adr(dbuf) + x, size(dbuf) - x);
	END;

	dbuf.dir_entry[ix] := dent;
	seekdir(df, bx);
	x := writef(df, adr(dbuf), size(dbuf));
END setdir;



PROCEDURE nextdir(
	VAR df:		fileDescriptor;
	VAR dx:		cardinal
);

VAR
	dent:		D_entry;

BEGIN
	dx := 0;
	WHILE getdir(df, dx, dent)
	  AND (dent.SEID.nsp <> null_nsp) DO
		inc(dx);
	END;
END nextdir;



PROCEDURE finddir(
	ex:             extentDescriptor;
	dj:             slotNumber;
	name:           ARRAY integer OF char;
	VAR jn:         slotNumber
):                      boolean;

VAR
	df:             fileDescriptor;
	jnode:          jNode;
	ix:             cardinal;
	dent:           D_entry;

BEGIN
	finddir := false;

	IF openf(df, ex, dj) THEN
		readj(ex, dj, jnode);
		IF isdir(jnode) THEN
			indir(df, name, ix);
			IF (ix <> nullPointer)
			AND getdir(df, ix, dent)
			AND (dent.SEID.nsp = same_nsp) THEN
				jn[1] := dent.SEID.uniq_id1;
				jn[0] := 0;
				finddir := true;
			END;
		END;

		closef(df);
	END;
END finddir;



PROCEDURE lookup(
	fullpathname:   ARRAY integer OF char;
	ex:             extentDescriptor;
	j0:             slotNumber;
	VAR pj:         slotNumber;
	VAR jn:         slotNumber;
	VAR leaf:       ARRAY integer OF char
):                      boolean;

VAR
	nam1,
	nam2:           ARRAY 0:127 OF char;

BEGIN
	split(fullpathname, nam1, nam2);

	IF fullpathname[0] = '/' THEN
		jn := firstUserSlot;
	ELSE
		jn := j0;
	END;

	pj := nullPointer32;

	LOOP
		WHEN nam1[0] = 0C DO
			lookup := true;
		EXIT;

		pj := jn;

		WHEN NOT finddir(ex, pj, nam1, jn) DO
			jn := nullPointer32;
			lookup := false;
		EXIT;

		copy(nam1, leaf);
		split(nam2, nam1, nam2);
	END;
END lookup;



END dir;
(*$L+*)



CONST
	KRD_what =      '@(#)krd.mod	1.2{0C}';



PROCEDURE krd;

VAR
	n :		integer;
	device :	ARRAY 0:31 OF char;
	extno:		cardinal;
	kfile:          ARRAY 0:63 OF char;
	pj,
	jn :		slotNumber;
	leaf:           ARRAY 0:15 OF char;
	buf :		ARRAY 0:255 OF integer;
	fl:		fileDescriptor;
	ex:		extentDescriptor;

BEGIN

	output(errout);
	puts('Device: ');
	flush;
	gets(device);

	puts('Extent: ');
	flush;
	extno := getc;

	IF NOT openx(ex, device, extno, 0) THEN
		err('can''t open extent');
	END;

	puts('KSOS file: ');
	flush;
	gets(kfile);

	IF NOT lookup(kfile, ex, firstUserSlot, pj, jn, leaf) THEN
		err('cannot find file');
	END;

	IF NOT openf(fl, ex, jn) THEN
		err('cannot open file');
	END;

	LOOP
		n := readf(fl, adr(buf), size(buf));
		WHEN n <= 0 EXIT;
		n := write(1, adr(buf), n);
	END;

	flush;
	closef(fl);
	closex(ex);
END krd;



BEGIN
	krd;
END main.
