worsley@ditmela.oz (Andrew Worsley) (05/18/89)
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 6 (of 10)."
# Contents: kerneldif/memory.c.cdif kerneldif/misc.c.cdif
# kerneldif/mpx286.x.cdif kerneldif/mpx88.x.cdif
# kerneldif/printer.c.cdif kerneldif/table.c.cdif
# Wrapped by sys@besplex on Sun Mar 26 06:34:16 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'kerneldif/memory.c.cdif' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'kerneldif/memory.c.cdif'\"
else
echo shar: Extracting \"'kerneldif/memory.c.cdif'\" \(3714 characters\)
sed "s/^X//" >'kerneldif/memory.c.cdif' <<'END_OF_FILE'
X*** kernel-1.3/memory.c Thu Oct 6 21:07:43 1988
X--- kernel/memory.c Sun Mar 5 02:41:00 1989
X***************
X*** 5,6 ****
X--- 5,7 ----
X * /dev/ram - RAM disk
X+ * /dev/port - i/o ports (i8088 only)
X * It accepts three messages, for reading, for writing, and for
X***************
X*** 31,36 ****
X #include "type.h"
X #include "proc.h"
X
X! #define NR_RAMS 4 /* number of RAM-type devices */
X! #define EM_ORIGIN 0x100000 /* origin of extended memory on the AT */
X PRIVATE message mess; /* message buffer */
X--- 32,41 ----
X #include "type.h"
X+ #include "glo.h"
X #include "proc.h"
X
X! #ifdef i8088
X! #define NR_RAMS 5 /* number of RAM-type devices */
X! #else
X! #define NR_RAMS 4
X! #endif
X PRIVATE message mess; /* message buffer */
X***************
X*** 48,56 ****
X extern unsigned sizes[8];
X! extern phys_clicks get_base();
X
X-
X /* Initialize this task. */
X! ram_origin[KMEM_DEV] = (phys_bytes) get_base() << CLICK_SHIFT;
X! ram_limit[KMEM_DEV] = (sizes[0] + sizes[1]) << CLICK_SHIFT;
X! ram_limit[MEM_DEV] = MEM_BYTES;
X
X--- 53,72 ----
X extern unsigned sizes[8];
X! extern phys_bytes umap();
X
X /* Initialize this task. */
X! ram_origin[KMEM_DEV] = umap(cproc_addr(SYSTASK), D, (vir_bytes) 0,
X! (vir_bytes) 1);
X! ram_limit[KMEM_DEV] = ((phys_bytes) sizes[1] << CLICK_SHIFT) +
X! ram_origin[KMEM_DEV];
X! #ifdef i8088
X! if (processor < 286)
X! ram_limit[MEM_DEV] = 0x100000;
X! else if (processor < 386)
X! ram_limit[MEM_DEV] = 0x1000000;
X! else
X! ram_limit[MEM_DEV] = MAX_P_LONG; /* not big enough */
X! ram_limit[PORT_DEV] = 0x10000;
X! #else
X! #error /* memory limit not set up */
X! #endif
X
X***************
X*** 90,97 ****
X {
X! /* Read or write /dev/null, /dev/mem, /dev/kmem, or /dev/ram. */
X
X! int device, count, words, status;
X phys_bytes mem_phys, user_phys;
X struct proc *rp;
X- extern phys_clicks get_base();
X extern phys_bytes umap();
X--- 106,112 ----
X {
X! /* Read or write /dev/null, /dev/mem, /dev/kmem, /dev/ram or /dev/port. */
X
X! int device, count, endport, port, portval;
X phys_bytes mem_phys, user_phys;
X struct proc *rp;
X extern phys_bytes umap();
X***************
X*** 115,134 ****
X
X! /* Copy the data. Origin above EM_ORIGIN means AT extended memory */
X! if (ram_origin[device] < EM_ORIGIN) {
X! /* Ordinary case. RAM disk is below 640K. */
X! if (m_ptr->m_type == DISK_READ)
X! phys_copy(mem_phys, user_phys, (long) count);
X! else
X! phys_copy(user_phys, mem_phys, (long) count);
X! } else {
X! /* AT with RAM disk in extended memory (above 1 MB). */
X! if (count & 1) panic("RAM disk got odd byte count\n", NO_NUM);
X! words = count >> 1; /* # words is half # bytes */
X! if (m_ptr->m_type == DISK_READ) {
X! status = em_xfer(mem_phys, user_phys, words);
X! } else {
X! status = em_xfer(user_phys, mem_phys, words);
X }
X! if (status != 0) count = -1;
X! }
X return(count);
X--- 130,155 ----
X
X! #ifdef PORT_DEV
X! /* Do special case of /dev/port. */
X! if (device == PORT_DEV) {
X! port = mem_phys;
X! mem_phys = umap(cproc_addr(MEM), D, (vir_bytes) &portval,
X! (vir_bytes) 1);
X! for (endport = port + count; port != endport; ++port) {
X! if (m_ptr->m_type == DISK_READ) {
X! port_in(port, &portval);
X! phys_copy(mem_phys, user_phys++, (phys_bytes) 1);
X! } else {
X! phys_copy(user_phys++, mem_phys, (phys_bytes) 1);
X! port_out(port, portval);
X! }
X }
X! return(count);
X! }
X! #endif
X!
X! /* Copy the data. */
X! if (m_ptr->m_type == DISK_READ)
X! phys_copy(mem_phys, user_phys, (long) count);
X! else
X! phys_copy(user_phys, mem_phys, (long) count);
X return(count);
END_OF_FILE
if test 3714 -ne `wc -c <'kerneldif/memory.c.cdif'`; then
echo shar: \"'kerneldif/memory.c.cdif'\" unpacked with wrong size!
fi
# end of 'kerneldif/memory.c.cdif'
fi
if test -f 'kerneldif/misc.c.cdif' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'kerneldif/misc.c.cdif'\"
else
echo shar: Extracting \"'kerneldif/misc.c.cdif'\" \(2738 characters\)
sed "s/^X//" >'kerneldif/misc.c.cdif' <<'END_OF_FILE'
X*** /dev/null Thu Oct 13 22:40:42 1988
X--- kernel/misc.c Thu Mar 23 03:15:44 1989
X***************
X*** 0 ****
X--- 1,74 ----
X+ /* This file contains a collection of miscellaneous procedures:
X+ * mem_init: initialize memory tables. Some memory is reported
X+ * by the BIOS, some is guesstimated and checked later
X+ */
X+
X+ #include "../h/const.h"
X+ #include "../h/type.h"
X+ #include "const.h"
X+ #include "type.h"
X+ #include "glo.h"
X+
X+ #ifdef i8088
X+
X+ #define EM_BASE 0x100000L /* base of extended memory on AT's */
X+ #define SHADOW_BASE 0xFA0000L /* base of RAM shadowing ROM on some AT's */
X+ #define SHADOW_MAX 0x060000L /* maximum usable shadow memory (16M limit) */
X+
X+ extern unsigned get_extmemsize();
X+ extern unsigned get_memsize();
X+
X+
X+ /*=========================================================================*
X+ * mem_init *
X+ *=========================================================================*/
X+ PUBLIC mem_init()
X+ {
X+ /* Initialize the memory size tables. This is complicated by fragmentation
X+ * and different access strategies for protected mode. There must be a
X+ * chunk at 0 big enough to hold Minix proper. For 286 and 386 processors,
X+ * there can be extended memory (memory above 1MB). This usually starts at
X+ * 1MB, but there may be another chunk just below 16MB, reserved under DOS
X+ * for shadowing ROM, but available to Minix if the hardware can be re-mapped.
X+ * In protected mode, extended memory is accessible assuming CLICK_SIZE is
X+ * large enough, and is treated as ordinary momory.
X+ * The magic bits for memory types are:
X+ * 1: extended
X+ * 0x80: must be checked since BIOS doesn't and it may not be there.
X+ */
X+
X+ /* Get the size of ordinary memory from the BIOS. */
X+ memsize[0] = k_to_click(get_memsize()); /* 0 base and type */
X+
X+ #ifdef SPARE_VIDEO_MEMORY
X+ /* Spare video memory. Experimental, it's too slow for program memory
X+ * except maybe on PC's, and belongs low in a memory hierarchy.
X+ */
X+ if (color) {
X+ memsize[1] = MONO_SIZE >> CLICK_SHIFT;
X+ membase[1] = MONO_BASE >> CLICK_SHIFT;
X+ } else {
X+ memsize[1] = COLOR_SIZE >> CLICK_SHIFT;
X+ membase[1] = COLOR_BASE >> CLICK_SHIFT;
X+ }
X+ memtype[1] = 0x80;
X+ #endif
X+
X+ if (pc_at) {
X+ /* Get the size of extended memory from the BIOS. This is special
X+ * except in protected mode, but protected mode is now normal.
X+ */
X+ memsize[2] = k_to_click(get_extmemsize());
X+ membase[2] = EM_BASE >> CLICK_SHIFT;
X+
X+ /* Shadow ROM memory. */
X+ memsize[3] = SHADOW_MAX >> CLICK_SHIFT;
X+ membase[3] = SHADOW_BASE >> CLICK_SHIFT;
X+ memtype[3] = 0x80;
X+ if (processor < 286) {
X+ memtype[2] = 1;
X+ memtype[3] |= 1;
X+ }
X+ }
X+ }
X+ #endif /* i8088 */
END_OF_FILE
if test 2738 -ne `wc -c <'kerneldif/misc.c.cdif'`; then
echo shar: \"'kerneldif/misc.c.cdif'\" unpacked with wrong size!
fi
# end of 'kerneldif/misc.c.cdif'
fi
if test -f 'kerneldif/mpx286.x.cdif' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'kerneldif/mpx286.x.cdif'\"
else
echo shar: Extracting \"'kerneldif/mpx286.x.cdif'\" \(7400 characters\)
sed "s/^X//" >'kerneldif/mpx286.x.cdif' <<'END_OF_FILE'
X*** /dev/null Thu Oct 13 22:40:42 1988
X--- kernel/mpx286.x Mon Mar 13 05:03:23 1989
X***************
X*** 0 ****
X--- 1,262 ----
X+ |*===========================================================================*
X+ |* mpx support for 286 protected mode *
X+ |*===========================================================================*
X+
X+ #include "const.h"
X+ #include "protect.h"
X+ #include "sconst.h"
X+ #define MPX286 .define
X+ #include "sglo.h"
X+
X+ .text
X+ |*===========================================================================*
X+ |* exception handlers *
X+ |*===========================================================================*
X+
X+ _divide_error:
X+ pushi8 (DIVIDE_VECTOR)
X+ j pexception
X+
X+ _nmi:
X+ pushi8 (NMI_VECTOR)
X+ j pexception
X+
X+ _overflow:
X+ pushi8 (OVERFLOW_VECTOR)
X+ j pexception
X+
X+ _bounds_check:
X+ pushi8 (BOUNDS_VECTOR)
X+ j pexception
X+
X+ _inval_opcode:
X+ pushi8 (INVAL_OP_VECTOR)
X+ j pexception
X+
X+ _copr_not_available:
X+ pushi8 (COPROC_NOT_VECTOR)
X+ j pexception
X+
X+ _double_fault:
X+ pushi8 (DOUBLE_FAULT_VECTOR)
X+ j perrexception
X+
X+ _copr_seg_overrun:
X+ pushi8 (COPROC_SEG_VECTOR)
X+ j pexception
X+
X+ _inval_tss:
X+ pushi8 (INVAL_TSS_VECTOR)
X+ j perrexception
X+
X+ _segment_not_present:
X+ pushi8 (SEG_NOT_VECTOR)
X+ j perrexception
X+
X+ _stack_exception:
X+ pushi8 (STACK_FAULT_VECTOR)
X+ j perrexception
X+
X+ _general_protection:
X+ pushi8 (PROTECTION_VECTOR)
X+ j perrexception
X+
X+
X+ |*===========================================================================*
X+ |* pexception *
X+ |*===========================================================================*
X+
X+ | This is called for all exceptions which don't push an error code.
X+
X+ pexception:
X+ seg ss
X+ pop ds_ex_number
X+ call p2_save
X+ j p1exception
X+
X+
X+ |*===========================================================================*
X+ |* perrexception *
X+ |*===========================================================================*
X+
X+ | This is called for all exceptions which push an error code.
X+
X+ p2_errexception:
X+ perrexception:
X+ seg ss
X+ pop ds_ex_number
X+ seg ss
X+ pop trap_errno
X+ call p2_save
X+ p1exception: | Common for all exceptions.
X+ push ds_ex_number
X+ call _exception
X+ add sp,#2
X+ cli
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* p2_save *
X+ |*===========================================================================*
X+
X+ | Save for 286 protected mode.
X+ | This is much simpler than for 8086 mode, because the stack already points
X+ | into process table, or has already been switched to the kernel stack.
X+
X+ p2_save:
X+ cld | set direction flag to a known value
X+ pusha | save "general" registers
X+ push ds | save ds
X+ push es | save es
X+ mov dx,ss | ss is kernel data segment
X+ mov ds,dx | load rest of kernel segments
X+ mov es,dx
X+ movb al,#ENABLE | reenable int controller
X+ out INT_CTL
X+ mov bp,sp | prepare to return
X+ incb _k_reenter | from -1 if not reentering
X+ jnz set_p1restart | stack is already kernel's
X+ mov sp,#k_stktop
X+ #ifdef SPLIMITS
X+ mov splimit,#k_stack+8
X+ #endif
X+ pushi16 (prestart) | build return address for interrupt handler
X+ jmpmem (RETADR-P_STACKBASE(bp))
X+
X+ set_p1restart:
X+ pushi16 (p1restart)
X+ jmpmem (RETADR-P_STACKBASE(bp))
X+
X+
X+ |*===========================================================================*
X+ |* p2_s_call *
X+ |*===========================================================================*
X+
X+ _p2_s_call:
X+ cld | set direction flag to a known value
X+ sub sp,#6*2 | skip RETADR, ax, cx, dx, bx, st
X+ push bp | stack already points into process table
X+ push si
X+ push di
X+ push ds
X+ push es
X+ mov dx,ss
X+ mov ds,dx
X+ mov es,dx
X+ incb _k_reenter
X+ mov si,sp | assumes P_STACKBASE == 0
X+ mov sp,#k_stktop
X+ #ifdef SPLIMTS
X+ mov splimit,#k_stack+8
X+ #endif
X+ | end of inline save
X+ sti | allow SWITCHER to be interrupted
X+ | now set up parameters for C routine sys_call
X+ push bx | pointer to user message
X+ push ax | src/dest
X+ push cx | SEND/RECEIVE/BOTH
X+ call _sys_call | sys_call(function, src_dest, m_ptr)
X+ | caller is now explicitly in proc_ptr
X+ mov AXREG(si),ax | sys_call MUST PRESERVE si
X+ cli
X+
X+ | Fall into code to restart proc/task running.
X+
X+ prestart:
X+
X+ | Flush any held-up interrupts.
X+ | This reenables interrupts, so the current interrupt handler may reenter.
X+ | This doesn't matter, because the current handler is about to exit and no
X+ | other handlers can reenter since flushing is only done when k_reenter == 0.
X+
X+ cmp _held_head,#0 | do fast test to usually avoid function call
X+ jz over_call_unhold
X+ call _unhold | this is rare so overhead is acceptable
X+ over_call_unhold:
X+ mov si,_proc_ptr
X+ #ifdef SPLIMITS
X+ mov ax,P_SPLIMIT(si) | splimit = p_splimit
X+ mov splimit,ax
X+ #endif
X+ deflldt (P_LDT_SEL(si)) | enable task's segment descriptors
X+ defsldt (_tss+TSS2_S_LDT)
X+ lea ax,P_STACKTOP(si) | arrange for next interrupt
X+ mov _tss+TSS2_S_SP0,ax | to save state in process table
X+ mov sp,si | assumes P_STACKBASE == 0
X+ p1restart:
X+ decb _k_reenter
X+ pop es
X+ pop ds
X+ popa
X+ add sp,#2 | skip RETADR
X+ iret | continue process
X+
X+
X+ |*===========================================================================*
X+ |* p_restart *
X+ |*===========================================================================*
X+
X+ | This now just starts the 1st task.
X+
X+ p_restart:
X+
X+ | Call the BIOS to switch to protected mode.
X+ | This is just to do any cleanup necessary, typically to disable a hardware
X+ | kludge which holds the A20 address line low.
X+
X+ | The call requires the gdt as we set it up:
X+ | gdt pointer in gdt[1]
X+ | ldt pointer in gdt[2]
X+ | new ds in gdt[3]
X+ | new es in gdt[4]
X+ | new ss in gdt[5]
X+ | new cs in gdt[6]
X+ | nothing in gdt[7] (overwritten with BIOS cs)
X+ | ICW2 for master 8259 in bh
X+ | ICW2 for slave 8259 in bl
X+ | Interrupts are enabled at the start but at the finish they are disabled in
X+ | both the processor flags and the interrupt controllers. Most registers are
X+ | destroyed. The 8259's are reinitialised.
X+
X+ in INT_CTLMASK | save interrupt masks
X+ push ax
X+ in INT2_MASK
X+ push ax
X+ movb al,#0xFF | protect against sti in BIOS
X+ out INT_CTLMASK
X+ mov si,#_gdt
X+ mov bx,#IRQ0_VECTOR * 256 orop IRQ8_VECTOR
X+ movb ah,#SET_PROTECT_FUNC
X+ pushf
X+ callfarptr(_vec_table+4*SET_PROTECT_VEC)
X+ pushi8 (0) | set kernel flags to known state, especially
X+ popf | clear nested task and interrupt enable
X+ pop ax | restore interrupt masks
X+ out INT2_MASK
X+ pop ax
X+ out INT_CTLMASK
X+
X+ deflidt (_gdt+IDT_SELECTOR) | loaded by BIOS, but in wrong mode!
X+ mov ax,#TSS_SELECTOR | no other TSS is used except by db
X+ defltrax
X+ sub ax,ax | zero, for no PRESENT bit
X+ movb _gdt+GDT_SELECTOR+DESC_ACCESS,al | zap invalid desc.
X+ movb _gdt+IDT_SELECTOR+DESC_ACCESS,al
X+ movb _gdt+BIOS_CS_SELECTOR+DESC_ACCESS,al
X+
X+ p2_resdone:
X+ jmp prestart
X+
X+
X+ |*===========================================================================*
X+ |* data *
X+ |*===========================================================================*
X+
X+ .bss
X+
X+ ds_ex_number:
X+ .space 2
X+ .space 2 | align
X+ trap_errno:
X+ .space 4 | large enough for mpx386 too
END_OF_FILE
if test 7400 -ne `wc -c <'kerneldif/mpx286.x.cdif'`; then
echo shar: \"'kerneldif/mpx286.x.cdif'\" unpacked with wrong size!
fi
# end of 'kerneldif/mpx286.x.cdif'
fi
if test -f 'kerneldif/mpx88.x.cdif' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'kerneldif/mpx88.x.cdif'\"
else
echo shar: Extracting \"'kerneldif/mpx88.x.cdif'\" \(16900 characters\)
sed "s/^X//" >'kerneldif/mpx88.x.cdif' <<'END_OF_FILE'
X*** /dev/null Thu Oct 13 22:40:42 1988
X--- kernel/mpx88.x Thu Mar 23 01:21:54 1989
X**************
X*** 0
X--- 1,589 -----
X+ | This file is part of the lowest layer of the MINIX kernel. The other parts
X+ | are "proc.c" and protected mode version(s) of this file. The lowest layer
X+ | does process switching and message handling.
X+
X+ | Every transition to the kernel goes through this file (or a protected mode
X+ | version). Transitions are caused by sending/receiving messages and by most
X+ | interrupts. (RS232 interrupts may be handled in the file "rs2.x" and then
X+ | they rarely enter the kernel.)
X+
X+ | Transitions to the kernel may be nested. The initial entry may be with a
X+ | system call, exception or hardware interrupt; reentries may only be made
X+ | by hardware interrupts. The count of reentries is kept in 'k_reenter'.
X+ | It is important for deciding whether to switch to the kernel stack and
X+ | for protecting the message passing code in "proc.c".
X+
X+ | For the message passing trap, most of the machine state is saved in the
X+ | proc table. (Some of the registers need not be saved.) Then the stack is
X+ | switched to 'k_stack', and interrupts are reenabled. Finally, the system
X+ | call handler (in C) is called. When it returns, interrupts are disabled
X+ | again and the code falls into the restart routine, to finish off held-up
X+ | interrupts and run the process or task whose pointer is in 'proc_ptr'.
X+
X+ | Hardware interrupt handlers do the same, except (1) The entire state must
X+ | be saved. (2) There are too many handlers to do this inline, so the save
X+ | routine is called. A few cycles are saved by pushing the address of the
X+ | appropiate restart routine for a return later. (3) A stack switch is
X+ | avoided when the stack is already switched. (4) The (master) 8259 interrupt
X+ | controller is reenabled centrally in save(). (5) Each interrupt handler
X+ | masks its interrupt line using the 8259 before enabling (other unmasked)
X+ | interrupts, and unmasks it after servicing the interrupt. This limits the
X+ | nest level to the number of lines and protects the handler from itself.
X+
X+ | The external entry points into this file are:
X+ | s_call: process or task wants to send or receive a message
X+ | tty_int: interrupt routine for each key depression and release
X+ | rs232_int: interrupt routine for each rs232 interrupt on port 1
X+ | secondary_int: interrupt routine for each rs232 interrupt on port 2
X+ | lpr_int: interrupt routine for each line printer interrupt
X+ | disk_int: disk interrupt routine
X+ | wini_int: winchester interrupt routine
X+ | clock_int: clock interrupt routine (HZ times per second)
X+ | eth_int: ethernet interrupt routine
X+ | int00-int16:handlers for unused interrupt vectors < 17
X+ | trp: all traps with vector >= 16 are vectored here
X+ | restart: start running a task or process
X+ | idle_task: executed when there is no work
X+
X+ | and for protected mode to patch
X+ | save: save the machine state in the proc table
X+
X+ | and for protected mode with C RS232 handlers, some duplicate labels to
X+ | avoid #if's elsewhere:
X+ | prs232_int: duplicate rs232_int
X+ | psecondary_int: duplicate secondary_int
X+
X+ #include "../h/const.h"
X+ #include "../h/com.h"
X+ #include "const.h"
X+ #include "sconst.h"
X+ #define MPX88 .define
X+ #include "sglo.h"
X+
X+ .text
X+
X+ begtext:
X+ |*===========================================================================*
X+ |* MINIX *
X+ |*===========================================================================*
X+ MINIX: | this is the entry point for the MINIX kernel.
X+ j over_kernel_ds | skip over the next few bytes
X+ .word CLICK_SHIFT | for build, later used by db for syms offset
X+ kernel_ds:
X+ .word 0 | build puts kernel DS here at fixed address 4
X+ over_kernel_ds:
X+ cli | disable interrupts
X+ cld | C compiler needs es = ds and direction = up
X+
X+ | this cli is redundant, fsck1.s already did it
X+ | NB stack is invalid here - fsck1.s did the wrong things
X+
X+ | copy boot parameters to kernel data, if any
X+
X+ seg cs
X+ mov es,kernel_ds
X+ test ax,ax | 0 for new boot, nonzero (scan code) for old
X+ jnz over_cp_param | skip copying parameters if old boot
X+ seg es
X+ mov dx,_sizeof_bparam
X+ cmp cx,dx
X+ jle over_adjust_param_count
X+ mov cx,dx
X+ over_adjust_param_count:
X+ mov ds,di | ds:si = parameters source
X+ mov di,#_boot_parameters | es:di = parameters target
X+ rep
X+ movb
X+ over_cp_param:
X+ mov ax,es
X+ mov ds,ax | ds now contains proper value
X+ mov ss,ax | ss now contains proper value
X+ mov _scan_code,bx | save scan code from bootstrap
X+ mov sp,#k_stktop | set sp to point to the top of kernel stack
X+ jmp _main | start the main program of MINIX
X+ | this should return by calling restart()
X+
X+
X+ |*===========================================================================*
X+ |* tty_int *
X+ |*===========================================================================*
X+ _tty_int: | Interrupt routine for terminal input.
X+ call save | save the machine state
X+ in INT_CTLMASK | mask out further keyboard interrupts
X+ orb al,#KEYBOARD_MASK
X+ out INT_CTLMASK
X+ sti | allow unmasked, non-keyboard, interrupts
X+ call _keyboard | process a keyboard interrupt
X+ cli
X+ in INT_CTLMASK | unmask keyboard interrupt
X+ andb al,#notop(KEYBOARD_MASK)
X+ out INT_CTLMASK
X+ ret | return to appropiate restart built by save()
X+
X+
X+ #ifdef C_RS232_INT_HANDLERS
X+ |*===========================================================================*
X+ |* rs232_int *
X+ |*===========================================================================*
X+ _rs232_int: | Interrupt routine for rs232 I/O.
X+ #ifdef i80286
X+ _prs232_int:
X+ #endif
X+ call save
X+ in INT_CTLMASK
X+ orb al,#RS232_MASK
X+ out INT_CTLMASK
X+
X+ | Don't enable interrupts, the handlers are not designed for it.
X+ | The mask was set as usual so the handler can reenable interrupts as desired.
X+
X+ call _rs232_1handler | process a serial line 1 interrupt
X+ in INT_CTLMASK
X+ andb al,#notop(RS232_MASK)
X+ out INT_CTLMASK
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* secondary_int *
X+ |*===========================================================================*
X+ _secondary_int: | Interrupt routine for rs232 port 2
X+ #ifdef i80286
X+ _psecondary_int:
X+ #endif
X+ call save
X+ in INT_CTLMASK
X+ orb al,#SECONDARY_MASK
X+ out INT_CTLMASK
X+ call _rs232_2handler | process a serial line 2 interrupt
X+ in INT_CTLMASK
X+ andb al,#notop(SECONDARY_MASK)
X+ out INT_CTLMASK
X+ ret
X+ #endif /* C_RS232_INT_HANDLERS */
X+
X+
X+ |*===========================================================================*
X+ |* lpr_int *
X+ |*===========================================================================*
X+ _lpr_int: | Interrupt routine for printer output.
X+ call save
X+ in INT_CTLMASK
X+ orb al,#PRINTER_MASK
X+ out INT_CTLMASK
X+ sti
X+ call _pr_char | process a line printer interrupt
X+ cli
X+ in INT_CTLMASK
X+ #ifdef ASLD
X+ andb al,#notop(PRINTER_MASK)
X+ #else
X+ andb al,#notop(PRINTER_MASK) & 0xFF
X+ #endif
X+ out INT_CTLMASK
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* disk_int *
X+ |*===========================================================================*
X+ _disk_int: | Interrupt routine for the floppy disk.
X+ call save
X+ cmp _ps,#0 | check for 2nd int controller on ps (?)
X+ je over_ps_disk
X+ movb al,#ENABLE
X+ out 0x3C
X+ over_ps_disk:
X+
X+ | The last doesn't make sense as an 8259 command, since the floppy vector
X+ | seems to be the same on PS's so the usual 8259 must be controlling it.
X+ | This used to be done at the start of the interrupt handler, in proc.c.
X+ | Find out where it really goes, and if there are any mask bits in port
X+ | 0x3D which have to be fiddled (here and in fdc_results()).
X+
X+ in INT_CTLMASK
X+ orb al,#FLOPPY_MASK
X+ out INT_CTLMASK
X+ sti
X+ mov ax,#FLOPPY
X+ push ax
X+ call _interrupt | interrupt(FLOPPY)
X+ add sp,#2
X+ cli
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* wini_int *
X+ |*===========================================================================*
X+ _wini_int: | Interrupt routine for the winchester disk.
X+ call save
X+ cmp _pc_at,#0 | check for 2nd int controller on AT
X+ jnz at_wini_int
X+
X+ xt_wini_int:
X+ in INT_CTLMASK
X+ orb al,#XT_WINI_MASK
X+ out INT_CTLMASK
X+ sti
X+ mov ax,#WINCHESTER
X+ push ax
X+ call _interrupt | interrupt(WINCHESTER)
X+ add sp,#2
X+ cli
X+ ret
X+
X+ at_wini_int:
X+ in INT2_MASK
X+ orb al,#AT_WINI_MASK
X+ out INT2_MASK
X+ sti
X+ movb al,#ENABLE | reenable slave 8259
X+ out INT2_CTL | the master one was done in save() as usual
X+ mov ax,#WINCHESTER
X+ push ax
X+ call _interrupt | interrupt(WINCHESTER)
X+ add sp,#2
X+ cli
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* clock_int *
X+ |*===========================================================================*
X+ _clock_int: | Interrupt routine for the clock.
X+ call save
X+ in INT_CTLMASK
X+ orb al,#CLOCK_MASK
X+ out INT_CTLMASK
X+ sti
X+ call _clock_handler | process a clock interrupt
X+ | This calls interrupt() only if necessary.
X+ | Very rarely.
X+ cli
X+ in INT_CTLMASK
X+ andb al,#notop(CLOCK_MASK)
X+ out INT_CTLMASK
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* eth_int *
X+ |*===========================================================================*
X+ _eth_int: | Interrupt routine for ethernet input
X+ call save
X+ in INT_CTLMASK
X+ orb al,#ETHER_MASK
X+ out INT_CTLMASK
X+ sti | may not be able to handle this
X+ | but ethernet doesn't work in protected mode
X+ | yet, and tacitly assumes CLICK_SIZE == 16
X+ call _dp8390_int | call the handler
X+ cli
X+ in INT_CTLMASK
X+ andb al,#notop(ETHER_MASK)
X+ out INT_CTLMASK
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* int00-16 *
X+ |*===========================================================================*
X+ _int00: | interrupt through vector 0
X+ push ax
X+ movb al,#0
X+ j exception
X+
X+ _int01: | interrupt through vector 1, etc
X+ push ax
X+ movb al,#1
X+ j exception
X+
X+ _int02:
X+ push ax
X+ movb al,#2
X+ j exception
X+
X+ _int03:
X+ push ax
X+ movb al,#3
X+ j exception
X+
X+ _int04:
X+ push ax
X+ movb al,#4
X+ j exception
X+
X+ _int05:
X+ push ax
X+ movb al,#5
X+ j exception
X+
X+ _int06:
X+ push ax
X+ movb al,#6
X+ j exception
X+
X+ _int07:
X+ push ax
X+ movb al,#7
X+ j exception
X+
X+ _int08:
X+ push ax
X+ movb al,#8
X+ j exception
X+
X+ _int09:
X+ push ax
X+ movb al,#9
X+ j exception
X+
X+ _int10:
X+ push ax
X+ movb al,#10
X+ j exception
X+
X+ _int11:
X+ push ax
X+ movb al,#11
X+ j exception
X+
X+ _int12:
X+ push ax
X+ movb al,#12
X+ j exception
X+
X+ _int13:
X+ push ax
X+ movb al,#13
X+ j exception
X+
X+ _int14:
X+ push ax
X+ movb al,#14
X+ j exception
X+
X+ _int15:
X+ push ax
X+ movb al,#15
X+ j exception
X+
X+ _int16:
X+ push ax
X+ movb al,#16
X+ j exception
X+
X+ _trp:
X+ push ax
X+ movb al,#17 | any vector above 17 becomes 17
X+
X+ exception:
X+ seg cs
X+ movb ex_number,al | it's cumbersome to get this into dseg
X+ pop ax
X+ call save
X+ seg cs
X+ push ex_number | high byte is constant 0
X+ call _exception | do whatever's necessary (sti only if safe)
X+ add sp,#2
X+ cli
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* save *
X+ |*===========================================================================*
X+ save: | save the machine state in the proc table.
X+ cld | set direction flag to a known value
X+ push ds
X+ push si
X+ seg cs
X+ mov ds,kernel_ds
X+ incb _k_reenter | from -1 if not reentering
X+ jnz push_current_stack | stack is already kernel's
X+
X+ mov si,_proc_ptr
X+ mov AXREG(si),ax
X+ mov BXREG(si),bx
X+ mov CXREG(si),cx
X+ mov DXREG(si),dx
X+ pop SIREG(si)
X+ mov DIREG(si),di
X+ mov BPREG(si),bp
X+ mov ESREG(si),es
X+ pop DSREG(si)
X+ pop bx | return adr
X+ pop PCREG(si)
X+ pop CSREG(si)
X+ pop PSWREG(si)
X+ mov SPREG(si),sp
X+ mov SSREG(si),ss
X+
X+ mov dx,ds
X+ mov ss,dx
X+ mov sp,#k_stktop
X+ #ifdef SPLIMITS
X+ mov splimit,#k_stack+8
X+ #endif
X+ mov ax,#_restart | build return address for interrupt handler
X+ push ax
X+
X+ stack_switched:
X+ mov es,dx
X+ movb al,#ENABLE | reenable int controller for everyone (early)
X+ out INT_CTL
X+ seg cs
X+ jmpreg (bx)
X+
X+ push_current_stack:
X+ push es
X+ push bp
X+ push di
X+ push dx
X+ push cx
X+ push bx
X+ push ax
X+ mov bp,sp
X+ mov bx,18(bp) | get the return adr; it becomes junk on stack
X+ mov ax,#restart1
X+ push ax
X+ mov dx,ss
X+ mov ds,dx
X+ j stack_switched
X+
X+
X+ |*===========================================================================*
X+ |* s_call *
X+ |*===========================================================================*
X+ _s_call: | System calls are vectored here.
X+ | Do save routine inline for speed,
X+ | but don't save ax, bx, cx, dx,
X+ | since C doesn't require preservation,
X+ | and ax returns the result code anyway.
X+ | Regs bp, si, di get saved by sys_call as
X+ | well, but it is impractical not to preserve
X+ | them here, in case context gets switched.
X+ | Some special-case code in pick_proc()
X+ | could avoid this.
X+ cld | set direction flag to a known value
X+ push ds
X+ push si
X+ seg cs
X+ mov ds,kernel_ds
X+ incb _k_reenter
X+ mov si,_proc_ptr
X+ pop SIREG(si)
X+ mov DIREG(si),di
X+ mov BPREG(si),bp
X+ mov ESREG(si),es
X+ pop DSREG(si)
X+ pop PCREG(si)
X+ pop CSREG(si)
X+ pop PSWREG(si)
X+ mov SPREG(si),sp
X+ mov SSREG(si),ss
X+ mov dx,ds
X+ mov es,dx
X+ mov ss,dx | interrupt handlers may not make system calls
X+ mov sp,#k_stktop | so stack is not already switched
X+ #ifdef SPLIMITS
X+ mov splimit,#k_stack+8
X+ #endif
X+ | end of inline save
X+ | now set up parameters for C routine sys_call
X+ push bx | pointer to user message
X+ push ax | src/dest
X+ push cx | SEND/RECEIVE/BOTH
X+ sti | allow SWITCHER to be interrupted
X+ call _sys_call | sys_call(function, src_dest, m_ptr)
X+ | caller is now explicitly in proc_ptr
X+ mov AXREG(si),ax | sys_call MUST PRESERVE si
X+ cli
X+
X+ | Fall into code to restart proc/task running.
X+
X+
X+ |*===========================================================================*
X+ |* restart *
X+ |*===========================================================================*
X+ _restart:
X+
X+ | Flush any held-up interrupts.
X+ | This reenables interrupts, so the current interrupt handler may reenter.
X+ | This doesn't matter, because the current handler is about to exit and no
X+ | other handlers can reenter since flushing is only done when k_reenter == 0.
X+
X+ cmp _held_head,#0 | do fast test to usually avoid function call
X+ jz over_call_unhold
X+ call _unhold | this is rare so overhead is acceptable
X+ over_call_unhold:
X+
X+ mov si,_proc_ptr
X+ #ifdef SPLIMITS
X+ mov ax,P_SPLIMIT(si) | splimit = p_splimit
X+ mov splimit,ax
X+ #endif
X+ decb _k_reenter
X+ mov ax,AXREG(si) | start restoring registers from proc table
X+ | could make AXREG == 0 to use lodw here
X+ mov bx,BXREG(si)
X+ mov cx,CXREG(si)
X+ mov dx,DXREG(si)
X+ mov di,DIREG(si)
X+ mov bp,BPREG(si)
X+ mov es,ESREG(si)
X+ mov ss,SSREG(si)
X+ mov sp,SPREG(si)
X+ push PSWREG(si) | fake interrupt stack frame
X+ push CSREG(si)
X+ push PCREG(si)
X+ | could put si:ds together to use
X+ | lds si,SIREG(si)
X+ push DSREG(si)
X+ mov si,SIREG(si)
X+ pop ds
X+ #ifdef DEBUGGER
X+ nop | for db emul. of iret - last pop will skip
X+ #endif
X+ iret | return to user or task
X+
X+ restart1:
X+ decb _k_reenter
X+ pop ax
X+ pop bx
X+ pop cx
X+ pop dx
X+ pop di
X+ pop bp
X+ pop es
X+ pop si
X+ pop ds
X+ add sp,#2 | skip return adr
X+ iret
X+
X+
X+ |*===========================================================================*
X+ |* idle *
X+ |*===========================================================================*
X+ _idle_task: | executed when there is no work
X+ j _idle_task | a "hlt" before this fails in protected mode
X+
X+
X+ |*===========================================================================*
X+ |* data *
X+ |*===========================================================================*
X+ ex_number: | exception number (stored in code segment)
X+ .space 2
X+
X+ .data
X+ begdata:
X+ _sizes: | sizes of kernel, mm, fs filled in by build
X+ .word 0x526F | this must be the first data entry (magic #)
X+ .zerow 7 | build table uses prev word and this space
X+ k_stack: | kernel stack
X+ .space K_STACK_BYTES
X+ k_stktop: | top of kernel stack
X+
X+ .bss
X+ begbss:
END_OF_FILE
if test 16900 -ne `wc -c <'kerneldif/mpx88.x.cdif'`; then
echo shar: \"'kerneldif/mpx88.x.cdif'\" unpacked with wrong size!
fi
# end of 'kerneldif/mpx88.x.cdif'
fi
if test -f 'kerneldif/printer.c.cdif' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'kerneldif/printer.c.cdif'\"
else
echo shar: Extracting \"'kerneldif/printer.c.cdif'\" \(6243 characters\)
sed "s/^X//" >'kerneldif/printer.c.cdif' <<'END_OF_FILE'
X*** kernel-1.3/printer.c Thu Oct 6 21:07:50 1988
X--- kernel/printer.c Fri Mar 10 00:01:18 1989
X***************
X*** 12,14 ****
X * -------------------------------------------------------
X! * | TTY_O_DONE |minor dev| | | |
X * |-------------+---------+---------+---------+---------|
X--- 12,14 ----
X * -------------------------------------------------------
X! * | TTY_O_DONE | | | | |
X * |-------------+---------+---------+---------+---------|
X***************
X*** 43,45 ****
X #define PR_MONO_BASE 0x3BC /* printer port when mono display used */
X- #define LOW_FOUR 0xF /* mask for low-order 4 bits */
X #define CANCELED -999 /* indicates that command has been killed */
X--- 43,44 ----
X***************
X*** 54,61 ****
X PRIVATE int orig_count; /* original byte count */
X! PRIVATE int es; /* (es, offset) point to next character to */
X! PRIVATE int offset; /* print, i.e., in the user's buffer */
X! PUBLIC int pcount; /* number of bytes left to print */
X! PUBLIC int pr_busy; /* TRUE when printing, else FALSE */
X! PUBLIC int cum_count; /* cumulative # characters printed */
X! PUBLIC int prev_ct; /* value of cum_count 100 msec ago */
X
X--- 53,61 ----
X PRIVATE int orig_count; /* original byte count */
X! PRIVATE phys_bytes offset; /* ptr to next char in user's buf to print */
X! PRIVATE int pcount; /* number of bytes left to print */
X! PRIVATE int pr_busy; /* TRUE when printing, else FALSE */
X! PRIVATE int cum_count; /* cumulative # characters printed */
X! PRIVATE int prev_ct; /* value of cum_count 100 msec ago */
X! PRIVATE int done_status; /* status of last output completion */
X! PRIVATE message int_mess; /* interrupt message for 1.3 compatibility */
X
X***************
X*** 77,80 ****
X case CANCEL : do_cancel(&print_mess); break;
X! case TTY_O_DONE: do_done(&print_mess); break;
X! default: break;
X }
X--- 77,82 ----
X case CANCEL : do_cancel(&print_mess); break;
X! case TTY_O_DONE: do_done(); break;
X! default: reply(TASK_REPLY, print_mess.m_source,
X! print_mess.PROC_NR, EINVAL);
X! break;
X }
X***************
X*** 92,96 ****
X
X! int i, j, r, value, old_state;
X struct proc *rp;
X- phys_bytes phys;
X extern phys_bytes umap();
X--- 94,97 ----
X
X! int i, j, r, value;
X struct proc *rp;
X extern phys_bytes umap();
X***************
X*** 105,108 ****
X rp = proc_addr(m_ptr->PROC_NR);
X! phys = umap(rp, D, (vir_bytes) m_ptr->ADDRESS, (vir_bytes)m_ptr->COUNT);
X! if (phys == 0) r = E_BAD_ADDR;
X
X--- 106,109 ----
X rp = proc_addr(m_ptr->PROC_NR);
X! offset = umap(rp, D, (vir_bytes) m_ptr->ADDRESS, (vir_bytes)m_ptr->COUNT);
X! if (offset == 0) r = E_BAD_ADDR;
X
X***************
X*** 110,112 ****
X /* Save information needed later. */
X! old_state = lock(); /* no interrupts now please */
X caller = m_ptr->m_source;
X--- 111,113 ----
X /* Save information needed later. */
X! sim_printer(); /* no printer interrupts now please */
X caller = m_ptr->m_source;
X***************
X*** 115,118 ****
X orig_count = m_ptr->COUNT;
X- es = (int) (phys >> CLICK_SHIFT);
X- offset = (int) (phys & LOW_FOUR);
X
X--- 116,117 ----
X***************
X*** 136,138 ****
X }
X! restore(old_state);
X }
X--- 135,137 ----
X }
X! cim_printer();
X }
X***************
X*** 148,151 ****
X *===========================================================================*/
X! PRIVATE do_done(m_ptr)
X! message *m_ptr; /* pointer to the newly arrived message */
X {
X--- 147,149 ----
X *===========================================================================*/
X! PRIVATE do_done()
X {
X***************
X*** 155,160 ****
X
X! status = (m_ptr->REP_STATUS == OK ? orig_count : EIO);
X if (proc_nr != CANCELED) {
X reply(REVIVE, caller, proc_nr, status);
X! if (status == EIO) pr_error(m_ptr->REP_STATUS);
X }
X--- 153,158 ----
X
X! status = (done_status == OK ? orig_count : EIO);
X if (proc_nr != CANCELED) {
X reply(REVIVE, caller, proc_nr, status);
X! if (status == EIO) pr_error(done_status);
X }
X***************
X*** 171,176 ****
X /* Cancel a print request that has already started. Usually this means that
X! * the process doing the printing has been killed by a signal.
X */
X
X- if (pr_busy == FALSE) return; /* this statement avoids race conditions */
X pr_busy = FALSE; /* mark printer as idle */
X--- 169,175 ----
X /* Cancel a print request that has already started. Usually this means that
X! * the process doing the printing has been killed by a signal. There is no
X! * need to do anything special about race conditions since resetting the
X! * flags here is harmless and it is an error to skip the reply.
X */
X
X pr_busy = FALSE; /* mark printer as idle */
X***************
X*** 246,251 ****
X int value, ch, i;
X- char c;
X- extern char get_byte();
X
X- if (pcount != orig_count) port_out(INT_CTL, ENABLE);
X if (pr_busy == FALSE) return; /* spurious 8259A interrupt */
X--- 245,247 ----
X***************
X*** 256,259 ****
X /* Everything is all right. Output another character. */
X! c = get_byte(es, offset); /* fetch char from user buf */
X! ch = c & BYTE;
X port_out(port_base, ch); /* output character */
X--- 252,254 ----
X /* Everything is all right. Output another character. */
X! ch = get_phys_byte(offset); /* fetch char from user buf */
X port_out(port_base, ch); /* output character */
X***************
X*** 274,276 ****
X int_mess.m_type = TTY_O_DONE;
X! int_mess.REP_STATUS = (pcount == 0 ? OK : value);
X interrupt(PRINTER, &int_mess);
X--- 269,271 ----
X int_mess.m_type = TTY_O_DONE;
X! done_status = (pcount == 0 ? OK : value);
X interrupt(PRINTER, &int_mess);
X***************
X*** 279 ****
X--- 274,287 ----
X
X+ /*==========================================================================*
X+ * pr_restart *
X+ *==========================================================================*/
X+ PUBLIC pr_restart()
X+ {
X+ /* Check if printer is hung up, and if so, restart it. */
X+
X+ if (pr_busy && pcount > 0 && cum_count == prev_ct && !tasim_printer()) {
X+ pr_char();
X+ cim_printer();
X+ }
X+ prev_ct = cum_count; /* record # characters printed so far */
X+ }
END_OF_FILE
if test 6243 -ne `wc -c <'kerneldif/printer.c.cdif'`; then
echo shar: \"'kerneldif/printer.c.cdif'\" unpacked with wrong size!
fi
# end of 'kerneldif/printer.c.cdif'
fi
if test -f 'kerneldif/table.c.cdif' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'kerneldif/table.c.cdif'\"
else
echo shar: Extracting \"'kerneldif/table.c.cdif'\" \(1373 characters\)
sed "s/^X//" >'kerneldif/table.c.cdif' <<'END_OF_FILE'
X*** kernel-1.3/table.c Thu Oct 6 21:07:55 1988
X--- kernel/table.c Thu Mar 23 03:04:00 1989
X***************
X*** 36,37 ****
X--- 36,38 ----
X
X+ extern int idle_task();
X extern int sys_task(), clock_task(), mem_task(), floppy_task(),
X***************
X*** 50,51 ****
X--- 51,53 ----
X #define TTY_STACK SMALL_STACK
X+ #define IDLE_STACK (3 * 3 * 2) /* 3 words each for int, temps & db */
X #define PRINTER_STACK SMALL_STACK
X***************
X*** 56,57 ****
X--- 58,60 ----
X #define SYS_STACK SMALL_STACK
X+ #define HARDWARE_STACK 0 /* dummy task, uses kernel stack */
X
X***************
X*** 68,69 ****
X--- 71,73 ----
X #define TOT_STACK_SPACE (TTY_STACK + AMOEBA_STACK_SPACE + \
X+ IDLE_STACK + HARDWARE_STACK + \
X PRINTER_STACK + WINCH_STACK + FLOP_STACK + \
X***************
X*** 90,91 ****
X--- 94,96 ----
X #endif
X+ idle_task, IDLE_STACK, "IDLE ",
X printer_task, PRINTER_STACK, "PRINTR",
X***************
X*** 96,98 ****
X sys_task, SYS_STACK, "SYS ",
X! 0, 0, "IDLE ",
X 0, 0, "MM ",
X--- 101,103 ----
X sys_task, SYS_STACK, "SYS ",
X! 0, HARDWARE_STACK, "HARDWA",
X 0, 0, "MM ",
X***************
X*** 102,107 ****
X
X! int t_stack[TOT_STACK_SPACE/sizeof (int)];
X!
X! int k_stack[K_STACK_BYTES/sizeof (int)]; /* The kernel stack. */
X!
X
X--- 107,109 ----
X
X! PUBLIC char t_stack[TOT_STACK_SPACE + ALIGNMENT - 1]; /* to be aligned */
X
END_OF_FILE
if test 1373 -ne `wc -c <'kerneldif/table.c.cdif'`; then
echo shar: \"'kerneldif/table.c.cdif'\" unpacked with wrong size!
fi
# end of 'kerneldif/table.c.cdif'
fi
echo shar: End of archive 6 \(of 10\).
cp /dev/null ark6isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 10 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
Division of Information Technology (Melbourne), Phone +61 3 347 8644
C.S.I.R.O. Fax +61 3 347 8987
55 Barry St. Telex AA 152914
Carlton, Vic, 3053, Australia E-mail: worsley@ditmela.oz.au