Category : Modula II Source Code
Archive   : FM2EXA.ZIP
Filename : KERNEL.MOD

 
Output of file : KERNEL.MOD contained in archive : FM2EXA.ZIP
IMPLEMENTATION MODULE Kernel;
(* $S-, $R-, $T- *)

(* (C) Copyright 1987 Fitted Software Tools. All rights reserved.

This module is part of the example multitasking communications program
provided with the Fitted Software Tools' Modula-2 development system.

Registered users may use this program as is, or they may modify it to
suit their needs or as an exercise.

If you develop interesting derivatives of this program and would like
to share it with others, we encourage you to upload a copy to our BBS.
*)


IMPORT SYSTEM, Storage;
FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, NEWPROCESS;
FROM System IMPORT TermProcedure, GetVector, SetVector, ResetVector;
FROM Storage IMPORT ALLOCATE;

TYPE
Process = POINTER TO ProcessDescriptor;
ProcessDescriptor = RECORD
proc :ADDRESS;
iop :BOOLEAN;
next :Process;
END;

SignalHeader = POINTER TO SignalRec;
SignalRec = RECORD
count :CARDINAL;
list :Process;
END;

LockHeader = POINTER TO LockRec;
LockRec = RECORD
locked :BOOLEAN;
owner :Process;
list :Process;
END;

VAR
cp :Process; (* executing process - head of ready list *)


PROCEDURE NewProcess( p :PROC; n :CARDINAL; iop :BOOLEAN );
(*
This procedure must be run at the "no priority" level because
of the way NEWPROCESS is implemented (please refer to the
documentation, under SYSTEM).
*)
VAR t :Process;
a :ADDRESS;
BEGIN
(* allocate the stack for the new process *)
ALLOCATE( a, n );
(* the new process is placed 2nd in ready list *)
NEW( t ); (* new process *)
NEWPROCESS( p, a, n, t^.proc ); (* created *)
t^.iop := iop;
t^.next := cp^.next; (* 2nd in list *)
cp^.next := t;
END NewProcess;


PROCEDURE InitSignal( VAR s :SignalHeader );
BEGIN
NEW( s );
s^.count := 0; s^.list := NIL;
END InitSignal;


PROCEDURE InitLock( VAR l :LockHeader );
BEGIN
NEW( l );
l^.locked := FALSE; l^.list := NIL;
END InitLock;


MODULE TheKernel[0]; (* the kernel runs with all interrupts disabled *)

IMPORT Process, SignalHeader, LockHeader, cp;
FROM SYSTEM IMPORT ADDRESS, TRANSFER, IOTRANSFER;
FROM Storage IMPORT ALLOCATE;

EXPORT Signal, Wait, WaitIO, Lock, Unlock;

PROCEDURE Signal( VAR s :SignalHeader );
VAR t, t0, t1 :Process;
BEGIN
WITH s^ DO
IF list <> NIL THEN
(* process(es) waiting for signal *)
(* get the first out of waiting list *)
t := list;
list := list^.next;

(* and put it into the ready list *)
(* after cp and any iop *)
t0 := cp;
t1 := cp^.next;
WHILE t1^.iop DO t0 := t1; t1 := t1^.next END;
t^.next := t1;
t0^.next := t;
ELSE
INC( count );
END;
END;
END Signal;


PROCEDURE Wait( VAR s :SignalHeader );
VAR t0, t1 :Process;
BEGIN
WITH s^ DO
IF count = 0 THEN
(* sorry, must wait... *)
t0 := cp;
cp := cp^.next; (* grab next to activate *)
t0^.next := NIL; (* t0 goes to end of wait list *)
IF list = NIL THEN
list := t0;
ELSE
t1 := list;
WHILE t1^.next <> NIL DO
t1 := t1^.next;
END;
t1^.next := t0;
END;
TRANSFER( t0^.proc, cp^.proc );
ELSE
(* just keep on going... *)
DEC( count );
END;
END;
END Wait;


PROCEDURE Lock( VAR l :LockHeader );
VAR t0, t1 :Process;
BEGIN
WITH l^ DO
IF NOT locked THEN
locked := TRUE; owner := cp;
ELSIF owner = cp THEN
(* we already own it... *)
ELSE
(* sorry, must wait... *)
t0 := cp;
cp := cp^.next; (* grab next to activate *)
t0^.next := NIL; (* t0 goes to end of wait list *)
IF list = NIL THEN
list := t0;
ELSE
t1 := list;
WHILE t1^.next <> NIL DO
t1 := t1^.next;
END;
t1^.next := t0;
END;
TRANSFER( t0^.proc, cp^.proc );
END;
END;
END Lock;


PROCEDURE Unlock( VAR l :LockHeader );
VAR t, t0, t1 :Process;
BEGIN
WITH l^ DO
IF locked & (owner = cp) THEN
locked := FALSE;
IF list <> NIL THEN
(* process(es) waiting for lock *)
(* get the first out of waiting list *)
t := list;
list := list^.next;

(* give it the lock *)
locked := TRUE;
owner := t;

(* and put it into the ready list *)
(* after cp and any iop *)
t0 := cp;
t1 := cp^.next;
WHILE t1^.iop DO t0 := t1; t1 := t1^.next END;
t^.next := t1;
t0^.next := t;
END;
END;
END;
END Unlock;


PROCEDURE WaitIO( v :CARDINAL );
VAR t0 :Process;
p :ADDRESS;
BEGIN
t0 := cp; (* get us out of ready list *)
cp := cp^.next;
p := cp^.proc;

IOTRANSFER( t0^.proc, p, v ); (* activate next process *)

(* and resume here *)
cp^.proc := p; (* save interrupted state *)
t0^.next := cp; (* resume driver *)
cp := t0;
END WaitIO;

END TheKernel;


(*PROCESS*) PROCEDURE idle; (* the idle process *)
BEGIN
LOOP END;
END idle;


PROCEDURE IgnoreInt;
BEGIN
ASM
PUSH AX
MOV AL, 20H
OUT 20H, AL
POP AX
IRET
END;
END IgnoreInt;

VAR OrgIntMask :BITSET;
OrgVectors :ARRAY [0..7] OF RECORD
saved :BOOLEAN;
IntAdrs :ADDRESS;
END;
i :CARDINAL;

PROCEDURE restore;
BEGIN
ASM
MOV AL, OrgIntMask
OUT 21H, AL
END;
FOR i := 0 TO 7 DO
WITH OrgVectors[i] DO
IF saved THEN
ResetVector( 8 + i, IntAdrs );
END;
END;
END;
END restore;

BEGIN
(* enable all the 8259 interrupts *)

(* first, get the current (original) interrupt mask *)
OrgIntMask := {};
ASM
IN AL, 21H
MOV OrgIntMask, AL
END;

(* save the interrupt vector values for all the disabled interrupts *)
FOR i := 0 TO 7 DO
WITH OrgVectors[i] DO
IF i IN OrgIntMask THEN
GetVector( 8 + i, IntAdrs );
saved := TRUE;
ELSE
saved := FALSE
END;
END;
END;

(* install our termination procedure *)
TermProcedure( restore );

(* install a dummy interrupt handler for all the originally
disabled interrupts.
*)
FOR i := 0 TO 7 DO
WITH OrgVectors[i] DO
IF saved THEN
SetVector( 8 + i, IgnoreInt );
END;
END;
END;

(* enable all the interrupts *)
ASM
MOV AL, 0
OUT 21H, AL
END;


(* start the kernel *)
NEW( cp ); cp^.next := NIL; (* main process *)
NewProcess( idle, 400, FALSE ); (* idle process *)

END Kernel.


  3 Responses to “Category : Modula II Source Code
Archive   : FM2EXA.ZIP
Filename : KERNEL.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/