Modula-2 is an actively used programming language created in 1978. 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...

41Years Old 520Users 2Jobs

Example code from the Hello World Collection:

(* Hello World in Modula-2 *)

MODULE HelloWorld;
FROM InOut IMPORT WriteString,WriteLn;
BEGIN
  WriteString("Hello World!");
  WriteLn;
END HelloWorld.

Example code from Linguist:

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.

Example code from Wikipedia:

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

Trending Repos

repo stars description

Last updated October 20th, 2019