Merge pull request #22 from tangentstorm/claude/port-oberon-free-pascal-1Wi4I

start on retro pascal (oberonc) targeting b4vm bytecode

Author: tangentstorm

pas/.gitignore

@@ -5,3 +5,7 @@ b4ix
 colortest
 mkoptbl
 disk.b4
+*.b4x
+*.b4a
+*.smb
+*.b4x

pas/Makefile

@@ -15,7 +15,8 @@ B4IX = b4ix$(EXE)
 B4A = b4a$(EXE)
 B4D = b4d$(EXE)
 MKOPTBL = mkoptbl$(EXE)
-BINS = $(B4) $(B4X) $(B4I) $(B4H) $(B4IX) $(B4A) $(B4D) $(MKOPTBL)
+OBERONC = oberonc$(EXE)
+BINS = $(B4) $(B4X) $(B4I) $(B4H) $(B4IX) $(B4A) $(B4D) $(MKOPTBL) $(OBERONC)
 
 main:
 	@echo 'usage : make <target> ARGS="..."'
@@ -32,6 +33,7 @@ main:
 	@echo ' runix: build/run b4ix (fancy interpreter)'
 	@echo ' runa : build/run b4a (batch assembler)'
 	@echo ' rund : build/run b4d (disassembler)'
+	@echo ' oberonc : compile the Oberon-07 to b4vm compiler'
 	@echo ' colortest: build/run colortest'
 
 always:
@@ -107,5 +109,15 @@ colortest: uhw_vt.pas colortest.pas
 	$(FPC) -B colortest.pas
 	./colortest
 
+$(OBERONC): ob/oberonc.pas ob/orp.pas ob/org.pas ob/orb.pas ob/ors.pas ob/org2.inc ob/org3.inc ob/org4.inc ob/orp2.inc
+	$(FPC) -o$(OBERONC) -Fuob -B ob/oberonc.pas
+
+oberonc: $(OBERONC)
+
+test-oberonc: $(OBERONC) $(B4)
+	./$(OBERONC) ob/test.ob
+	echo "--- running on b4vm ---"
+	./$(B4) -l test.b4x
+
 clean:
-	@rm -f *.o *.ppu *.exe $(BINS) link*.res *~
+	@rm -f *.o *.ppu *.exe $(BINS) link*.res *~ ob/*.o ob/*.ppu

pas/ob/.gitignore

@@ -0,0 +1,7 @@
+oberonc
+*.o
+*.ppu
+*.b4x
+link*.res
+*.b4a
+*.smb

pas/ob/examples/adder.ob

@@ -0,0 +1,8 @@
+MODULE Adder;
+  IMPORT In, Out;
+  VAR a, b: INTEGER;
+BEGIN
+  In.Int(a);
+  In.Int(b);
+  Out.Int(a + b, 0); Out.Ln
+END Adder.

pas/ob/examples/fibonacci.ob

@@ -0,0 +1,26 @@
+MODULE Fibonacci;
+  VAR i, n: INTEGER;
+
+  PROCEDURE Fib(n: INTEGER): INTEGER;
+    VAR a, b, t: INTEGER;
+  BEGIN
+    a := 0; b := 1;
+    WHILE n > 0 DO
+      t := b;
+      b := a + b;
+      a := t;
+      DEC(n)
+    END;
+    RETURN a
+  END Fib;
+
+BEGIN
+  (* compute first 12 Fibonacci numbers *)
+  (* results stored in memory starting at global n *)
+  i := 0;
+  WHILE i <= 12 DO
+    n := Fib(i);
+    INC(i)
+  END
+  (* n ends up as Fib(12) = 144 *)
+END Fibonacci.

pas/ob/examples/gcd.ob

@@ -0,0 +1,17 @@
+MODULE GCD;
+  VAR result: INTEGER;
+
+  PROCEDURE Gcd(a, b: INTEGER): INTEGER;
+  BEGIN
+    WHILE a # b DO
+      IF a > b THEN a := a - b
+      ELSE b := b - a
+      END
+    END;
+    RETURN a
+  END Gcd;
+
+BEGIN
+  result := Gcd(36, 24)
+  (* result = 12 *)
+END GCD.

pas/ob/examples/hello.ob

@@ -0,0 +1,18 @@
+module Hello;
+  import Out;
+  var i, f: INTEGER;
+
+  procedure Fact(n: INTEGER): INTEGER;
+    var r: INTEGER;
+  begin r := 1; while n > 1 do r := r * n; DEC(n) end; return r
+  end Fact;
+
+begin
+  i := 1;
+  while i <= 10 do
+    f := Fact(i);
+    Out.Int(f, 0); Out.Char(32);
+    INC(i)
+  end;
+  Out.Ln
+end Hello.

pas/ob/examples/power.ob

@@ -0,0 +1,20 @@
+MODULE Power;
+  (* Integer exponentiation by squaring *)
+  VAR result: INTEGER;
+
+  PROCEDURE Pow(base, exp: INTEGER): INTEGER;
+    VAR r: INTEGER;
+  BEGIN
+    r := 1;
+    WHILE exp > 0 DO
+      IF ODD(exp) THEN r := r * base END;
+      base := base * base;
+      exp := exp DIV 2
+    END;
+    RETURN r
+  END Pow;
+
+BEGIN
+  result := Pow(2, 10)
+  (* result = 1024 *)
+END Power.

pas/ob/examples/records.ob

@@ -0,0 +1,15 @@
+MODULE Records;
+  (* Demonstrate record types *)
+  TYPE
+    Point = RECORD x, y: INTEGER END;
+
+  VAR
+    p: Point;
+    sum: INTEGER;
+
+BEGIN
+  p.x := 3;
+  p.y := 4;
+  sum := p.x + p.y
+  (* sum = 7 *)
+END Records.

pas/ob/examples/sieve.ob

@@ -0,0 +1,37 @@
+MODULE Sieve;
+  (* Sieve of Eratosthenes - find primes up to 100 *)
+  CONST N = 100;
+  VAR
+    sieve: ARRAY N OF BOOLEAN;
+    i, j, count: INTEGER;
+
+BEGIN
+  (* initialize: assume all are prime *)
+  i := 2;
+  WHILE i < N DO
+    sieve[i] := TRUE;
+    INC(i)
+  END;
+
+  (* sieve *)
+  i := 2;
+  WHILE i * i < N DO
+    IF sieve[i] THEN
+      j := i * i;
+      WHILE j < N DO
+        sieve[j] := FALSE;
+        j := j + i
+      END
+    END;
+    INC(i)
+  END;
+
+  (* count primes *)
+  count := 0;
+  i := 2;
+  WHILE i < N DO
+    IF sieve[i] THEN INC(count) END;
+    INC(i)
+  END
+  (* count = 25, the number of primes below 100 *)
+END Sieve.