Modula-2 is a programming language created in 1978 by Niklaus Wirth.
| #299on PLDB | 46Years Old | 306Repos |
Modula-2 is a computer programming language designed and developed between 1977 and 1985 by Niklaus Wirth at the Swiss Federal Institute of Technology in Zurich (ETH Zurich) as a revision of Pascal to serve as the sole programming language for the operating system and application software for the personal workstation Lilith. The principal concepts were: The module as a compilation unit for separate compilation The coroutine as the basic building block for concurrent processes Types and procedures that allow access to machine-specific data. Modula-2 was viewed by Niklaus Wirth as a successor to his earlier programming languages Pascal and Modula. Read more on Wikipedia...
MODULE HelloWorld;
FROM Terminal2 IMPORT WriteString, WriteLn;
BEGIN
WriteString("Hello World");
WriteLn;
END HelloWorld.(* Hello World in Modula-2 *)
MODULE HelloWorld;
FROM InOut IMPORT WriteString,WriteLn;
BEGIN
WriteString("Hello World!");
WriteLn;
END HelloWorld.
IMPLEMENTATION MODULE HuffChan;
(*
This module shows how to redefine standard IO file functions. It provides
functions for reading and writing packed files opened in Raw mode.
*)
IMPORT IOChan, IOLink, ChanConsts, IOConsts, SYSTEM, Strings;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
CONST
rbldFrq = 512; (* means: every 512 bytes rebuild table *)
TYPE
charTap = POINTER TO ARRAY [0..MAX(INTEGER)-1] OF CHAR;
smbTp = POINTER TO smbT;
smbT = RECORD (* Huffman's tree *)
ch : CHAR;
n : CARDINAL; (* frequncy of char ch *)
left,right,next : smbTp;
END;
tblT = RECORD (* bit sequence for code *)
vl : CARDINAL; (* bit sequence *)
cnt : INTEGER; (* it length *)
END;
lclDataT = RECORD (* channel's local data *)
tRoot : smbTp;
htbl : ARRAY [0..255] OF tblT; (* code -> bit sequence table *)
ftbl : ARRAY [0..255] OF CARDINAL; (* frequncey table *)
wBf,rb1,rb2 : CARDINAL;
wbc,rbc,smc : INTEGER;
chid : IOChan.ChanId;
END;
lclDataTp = POINTER TO lclDataT;
charp = POINTER TO CHAR;
VAR
did : IOLink.DeviceId;
ldt : lclDataTp;
PROCEDURE Shf(a:CARDINAL; b : INTEGER) : CARDINAL; (* shl a,b (or shr) *)
BEGIN
RETURN SYSTEM.CAST(CARDINAL,SYSTEM.SHIFT(SYSTEM.CAST(BITSET,a),b));
END Shf;
PROCEDURE wrDword(a:CARDINAL); (* write 4 bytes to file *)
BEGIN
IOChan.RawWrite(ldt^.chid,SYSTEM.ADR(a),4);
END wrDword;
PROCEDURE rdDword() : CARDINAL; (* read 4 bytes from file *)
VAR
a,z : CARDINAL;
BEGIN
a:=0;
IOChan.RawRead(ldt^.chid,SYSTEM.ADR(a),4,z);
RETURN a;
END rdDword;
PROCEDURE wrSmb(ch : CHAR); (* write bit sequence for code ch *)
VAR
v,h : CARDINAL;
b,c : INTEGER;
BEGIN
WITH ldt^ DO
v:=htbl[ORD(ch)].vl;
c:=htbl[ORD(ch)].cnt;
IF c+wbc<=32 THEN
wBf:=Shf(wBf,c);
wBf:=wBf+v;
wbc:=wbc+c;
IF wbc=32 THEN
wrDword(wBf);
wBf:=0; wbc:=0;
END;
RETURN;
END;
b:=c+wbc-32;
h:=Shf(v,-b);
wBf:=Shf(wBf,32-wbc)+h;
wrDword(wBf);
wBf:=v-Shf(h,b);
wbc:=b;
END;
END wrSmb;
PROCEDURE flush(); (* write data in buffer *)
BEGIN
WITH ldt^ DO
wBf:=Shf(wBf,32-wbc);
wrDword(wBf);
END;
END flush;
PROCEDURE getSym() : CHAR; (* find code for first bit sequence in buffer *)
VAR
t,i : CARDINAL;
b : INTEGER;
BEGIN
WITH ldt^ DO
IF rbc<=32 THEN
rb2:=rdDword();
t:=Shf(rb2,-rbc);
IF rbc=32 THEN t:=0; END;
rb1:=rb1+t;
rb2:=Shf(rb2,32-rbc);
IF rbc=0 THEN rb2:=0; END;
rbc:=rbc+32;
END;
FOR i:=0 TO 255 DO
t:=Shf(rb1,htbl[i].cnt-32);
IF t=htbl[i].vl THEN
rb1:=Shf(rb1,htbl[i].cnt);
b:=32-htbl[i].cnt;
t:=Shf(rb2,-b);
rb1:=rb1+t;
rb2:=Shf(rb2,32-b);
rbc:=rbc+b-32;
RETURN CHR(i);
END;
END;
END;
END getSym;
PROCEDURE Insert(s : smbTp); (* insert new character in Huffman's tree *)
VAR
cr : smbTp;
BEGIN
WITH ldt^ DO
IF tRoot=NIL THEN
cr:=tRoot;
tRoot:=s;
s^.next:=cr;
RETURN;
ELSIF tRoot^.n<=s^.n THEN
cr:=tRoot;
tRoot:=s;
s^.next:=cr;
RETURN;
END;
cr:=tRoot;
WHILE (cr^.next<>NIL) & (cr^.next^.n>s^.n) DO
cr:=cr^.next;
END;
s^.next:=cr^.next;
cr^.next:=s;
END;
END Insert;
PROCEDURE BuildTree(); (* build Huffman's tree *)
VAR
cr,ocr,ncr : smbTp;
BEGIN
WITH ldt^ DO
LOOP
ocr:=NIL; cr:=tRoot;
WHILE cr^.next^.next<>NIL DO
ocr:=cr; cr:=cr^.next;
END;
NEW(ncr);
ncr^.n:=cr^.n+cr^.next^.n;
ncr^.left:=cr;
ncr^.right:=cr^.next;
IF ocr<>NIL THEN
ocr^.next:=NIL;
Insert(ncr);
ELSE
tRoot:=NIL;
Insert(ncr);
EXIT;
END;
END;
END;
END BuildTree;
PROCEDURE BuildTable(cr: smbTp; vl,n: CARDINAL); (* build table: code -> bit sequence *)
BEGIN
WITH ldt^ DO
IF cr^.left=NIL THEN
htbl[ORD(cr^.ch)].vl:=vl;
htbl[ORD(cr^.ch)].cnt:=n;
DISPOSE(cr);
RETURN;
END;
vl:=vl*2;
BuildTable(cr^.left,vl,n+1);
BuildTable(cr^.right,vl+1,n+1);
DISPOSE(cr);
END;
END BuildTable;
PROCEDURE clcTab(); (* build code/bitseq. table from frequency table *)
VAR
i : CARDINAL;
s : smbTp;
BEGIN
WITH ldt^ DO
tRoot:=NIL;
FOR i:=0 TO 255 DO
NEW(s);
s^.ch:=CHR(i);
s^.n:=ftbl[i];
s^.left:=NIL; s^.right:=NIL; s^.next:=NIL;
Insert(s);
END;
BuildTree();
BuildTable(tRoot,0,0);
END;
END clcTab;
PROCEDURE iniHuf();
VAR
i : CARDINAL;
BEGIN
WITH ldt^ DO
FOR i:=0 TO 255 DO
ftbl[i]:=1;
END;
wBf:=0; wbc:=0; rb1:=0; rb2:=0; rbc:=0;
smc:=0;
clcTab();
END;
END iniHuf;
PROCEDURE RawWrite(x: IOLink.DeviceTablePtr; buf: SYSTEM.ADDRESS;
len: CARDINAL);
VAR
i : CARDINAL;
ch : CHAR;
cht : charTap;
BEGIN
IF len = 0 THEN RETURN; END;
ldt:=SYSTEM.CAST(lclDataTp,x^.cd);
cht:=SYSTEM.CAST(charTap,buf);
WITH ldt^ DO
FOR i:=0 TO len-1 DO
ch:=cht^[i];
wrSmb(ch);
IF ch = 377C THEN wrSmb(ch); END;
ftbl[ORD(ch)]:=ftbl[ORD(ch)]+1; smc:=smc+1;
IF smc=rbldFrq THEN
clcTab();
smc:=0;
END;
END;
END;
x^.result:=IOChan.ReadResult(ldt^.chid);
END RawWrite;
PROCEDURE RawRead(x: IOLink.DeviceTablePtr; buf: SYSTEM.ADDRESS;
blen: CARDINAL; VAR len: CARDINAL);
VAR
i : CARDINAL;
cht : charTap;
ch : CHAR;
BEGIN
ldt:=SYSTEM.CAST(lclDataTp,x^.cd);
cht:=SYSTEM.CAST(charTap,buf);
IF (blen=0) OR (x^.result<>IOConsts.allRight) THEN len:=0; RETURN; END;
WITH ldt^ DO
FOR i:=0 TO blen-1 DO
ch:=getSym();
IF ch = 377C THEN
ch:=getSym();
IF ch = 0C THEN
x^.result:=IOConsts.endOfInput;
len:=i; cht^[i]:=0C;
RETURN;
END;
END;
cht^[i]:=ch;
ftbl[ORD(ch)]:=ftbl[ORD(ch)]+1; smc:=smc+1;
IF smc=rbldFrq THEN
clcTab();
smc:=0;
END;
END;
len:=blen;
END;
END RawRead;
PROCEDURE CreateAlias(VAR cid: ChanId; io: ChanId; VAR res: OpenResults);
VAR
x : IOLink.DeviceTablePtr;
BEGIN
IOLink.MakeChan(did,cid);
IF cid = IOChan.InvalidChan() THEN
res:=ChanConsts.outOfChans
ELSE
NEW(ldt);
IF ldt=NIL THEN
IOLink.UnMakeChan(did,cid);
res:=ChanConsts.outOfChans;
RETURN;
END;
x:=IOLink.DeviceTablePtrValue(cid,did,IOChan.notAvailable,"");
ldt^.chid:=io;
x^.cd:=ldt;
x^.doRawWrite:=RawWrite;
x^.doRawRead:=RawRead;
res:=ChanConsts.opened;
iniHuf();
x^.result:=IOConsts.allRight;
END;
END CreateAlias;
PROCEDURE DeleteAlias(VAR cid: ChanId);
VAR
x : IOLink.DeviceTablePtr;
BEGIN
x:=IOLink.DeviceTablePtrValue(cid,did,IOChan.notAvailable,"");
ldt:=x^.cd;
IF ldt^.rbc=0 THEN
wrSmb(377C);
wrSmb(0C);
flush();
END;
DISPOSE(ldt);
IOLink.UnMakeChan(did,cid);
END DeleteAlias;
BEGIN
IOLink.AllocateDeviceId(did);
END HuffChan.
ABS EXCL LONGINT REAL
BITSET FALSE LONGREAL SIZE
BOOLEAN FLOAT MAX TRUE
CAP HALT MIN TRUNC
CARDINAL HIGH NIL VAL
CHAR INC ODD
CHR INCL ORD
DEC INTEGER PROC| Feature | Supported | Example | Token |
|---|---|---|---|
| Booleans | ✓ | TRUE FALSE | |
| Strings | ✓ | "Hello world" | " |
| Print() Debugging | ✓ | WriteString | |
| MultiLine Comments | ✓ | (* A comment *) | (* *) |
| Pointers | ✓ | ||
| Comments | ✓ | ||
| Case Insensitive Identifiers | X | ||
| Semantic Indentation | X | ||
| Operator Overloading | X | ||
| Line Comments | X |