Pascal → Bascom BASIC

Below is a single document that contains:

  1. a restricted Turbo-Pascal-style program (stack-friendly), and
  2. the generated Bascom-compatible BASIC that uses explicit stacks to pass parameters and return values (numeric, string, and a tiny “record” stack for Point(x,y)).

Part A — Source (Restricted Pascal)

program StackStrategyDemo;

type
  IntArr  = array[1..100] of integer;
  Grade   = (grFail, grPass, grMerit, grDist, grMax);
  Point   = record x, y: integer; end;

var
  a         : IntArr;
  n, i      : integer;
  s, mn, mx : integer;
  g         : Grade;
  p         : Point;
  labelStr  : string[16];

function Tri(n: integer): integer;
var
  k, t: integer;
begin
  t := 0;
  for k := 1 to n do
    t := t + k;
  Tri := t;
end;

procedure Stats(var arr: IntArr; n: integer; var sum, minv, maxv: integer);
var
  i, v: integer;
begin
  if n <= 0 then
  begin sum := 0; minv := 0; maxv := 0; exit; end;
  sum := 0; minv := arr[1]; maxv := arr[1];
  for i := 1 to n do
  begin
    v := arr[i];
    sum := sum + v;
    if v < minv then minv := v;
    if v > maxv then maxv := v;
  end;
end;

function Classify(score: integer): integer;
begin
  case score of
    0..39:    Classify := ord(grFail);
    40..54:   Classify := ord(grPass);
    55..69:   Classify := ord(grMerit);
    70..100:  Classify := ord(grDist);
  else
    Classify := ord(grMax);
  end;
end;

function ClassLabel(c: integer): string[16];
begin
  case c of
    0: ClassLabel := 'FAIL';
    1: ClassLabel := 'PASS';
    2: ClassLabel := 'MERIT';
    3: ClassLabel := 'DIST';
  else
    ClassLabel := 'N/A';
  end;
end;

procedure NormalizePoint(var p: Point);
begin
  if p.x < 0 then p.x := -p.x;
  if p.y < 0 then p.y := -p.y;
end;

function Dist2(p: Point): integer;
var
  dx, dy: integer;
begin
  dx := p.x; dy := p.y;
  Dist2 := dx*dx + dy*dy;
end;

begin
  n := 10;
  for i := 1 to n do
    a[i] := i * (i mod 3 + 1);

  i := 0;
  repeat i := i + 1 until i >= 3;

  s := Tri(10);
  Stats(a, n, s, mn, mx);

  g := Grade(Classify(72));
  labelStr := ClassLabel(ord(g));

  p.x := -3; p.y := 4;
  NormalizePoint(p);
  while (p.x + p.y) < 20 do
  begin p.x := p.x + 2; p.y := p.y + 1; end;

  mx := Dist2(p);

  writeln('Tri(10)=', s);
  writeln('Sum=', s, ' Min=', mn, ' Max=', mx);
  writeln('Class=', ord(g), ' Label=', labelStr);
  writeln('Point(', p.x, ',', p.y, ') Dist2=', mx);
end.

Part B — Generated BASIC (Bascom-compatible, stacks for params/returns, minimal line numbers)

Calling convention:

  • Numeric stack NS() with pointer NSP; push via 20000, pop via 20010.
  • String stack SS$() with pointer SSP; push via 20100, pop via 20110.
  • “Record” stack for Point(x,y) via PXS(), PYS() with pointer PSP; push 21000, pop 21010.
  • Routines GOSUB pop their own params and push returns back onto the appropriate stack.
  • Main is mostly unnumbered; lines only where a GOTO/GOSUB target is needed.
REM ===== Bascom-compatible output: stack-based calling =====
OPTION BASE 1
DEFINT A-Z

' ---- Stacks ----
DIM NS(256)            ' numeric stack
DIM SS$(256)           ' string stack
DIM PXS(64), PYS(64)   ' "record" stack for Point(x,y)
NSP = 0
SSP = 0
PSP = 0

' ---- Scratch for stack ops & calls ----
TMP = 0
STMP$ = ""
PXTMP = 0
PYTMP = 0

' ---- Program data ----
DIM A(100)
N = 10

' Fill input array
FOR I = 1 TO N
  A(I) = I * (I MOD 3 + 1)
NEXT I

' repeat i := i + 1 until i >= 3
I = 0
900 I = I + 1
910 IF I < 3 THEN GOTO 900

' s := Tri(10)
TMP = 10: GOSUB 20000      ' N_PUSH(10)
GOSUB 1000                 ' Tri pops n, pushes result
GOSUB 20010: S = TMP       ' N_POP -> S

' Stats(a,n,s,mn,mx) modeled as: push n; routine reads A() and pushes S, MN, MX
TMP = N: GOSUB 20000       ' N_PUSH(n)
GOSUB 1100                 ' pushes (S, MN, MX) in that order
GOSUB 20010: MX = TMP
GOSUB 20010: MN = TMP
GOSUB 20010: S  = TMP

' g := Classify(72)
TMP = 72: GOSUB 20000
GOSUB 1200
GOSUB 20010: G = TMP

' labelStr$ := ClassLabel(g)
TMP = G: GOSUB 20000
GOSUB 1300
GOSUB 20110: LabelStr$ = STMP$

' p := (-3,4) → NormalizePoint(p) (record stack round-trip)
PXTMP = -3: PYTMP = 4: GOSUB 21000   ' P_PUSH
GOSSUB 1400                          ' normalize (pop->push)
GOSUB 21010: PX = PXTMP: PY = PYTMP  ' P_POP to vars

' while (PX+PY) < 20: PX+=2, PY+=1
920 IF PX + PY >= 20 THEN GOTO 940
930 PX = PX + 2: PY = PY + 1: GOTO 920
940 ' end while

' mx := Dist2(p)
PXTMP = PX: PYTMP = PY: GOSUB 21000  ' P_PUSH
GOSUB 1500                           ' Dist2 pops point, pushes result
GOSUB 20010: MX = TMP                ' N_POP -> MX

PRINT "Tri(10)=", S
PRINT "Sum=", S; " Min=", MN; " Max=", MX
PRINT "Class=", G; " Label=", LabelStr$
PRINT "Point("; PX; ","; PY; ") Dist2=", MX

END

' ========================= ROUTINES =========================

' Tri(n: integer): integer — numeric stack
1000 GOSUB 20010: N0 = TMP
1010 T0 = 0
1020 FOR K0 = 1 TO N0
1030   T0 = T0 + K0
1040 NEXT K0
1050 TMP = T0: GOSUB 20000
1060 RETURN

' Stats(n: integer): pushes S, MN, MX — reads global A()
1100 GOSUB 20010: N0 = TMP
1110 IF N0 <= 0 THEN S0 = 0: MN0 = 0: MX0 = 0: GOTO 1150
1120 S0 = 0: MN0 = A(1): MX0 = A(1)
1130 FOR I0 = 1 TO N0
1140   V0 = A(I0)
1145   S0 = S0 + V0
1146   IF V0 < MN0 THEN MN0 = V0
1147   IF V0 > MX0 THEN MX0 = V0
1148 NEXT I0
1150 TMP = S0:  GOSUB 20000
1160 TMP = MN0: GOSUB 20000
1170 TMP = MX0: GOSUB 20000
1180 RETURN

' Classify(score: integer): integer — numeric stack
1200 GOSUB 20010: SC0 = TMP
1210 IF SC0 >= 0  AND SC0 <= 39  THEN TMP = 0: GOSUB 20000: RETURN
1220 IF SC0 >= 40 AND SC0 <= 54  THEN TMP = 1: GOSUB 20000: RETURN
1230 IF SC0 >= 55 AND SC0 <= 69  THEN TMP = 2: GOSUB 20000: RETURN
1240 IF SC0 >= 70 AND SC0 <= 100 THEN TMP = 3: GOSUB 20000: RETURN
1250 TMP = 4: GOSUB 20000
1260 RETURN

' ClassLabel(c: integer): string — string stack
1300 GOSUB 20010: C0 = TMP
1310 IF C0 = 0 THEN STMP$ = "FAIL":  GOSUB 20100: RETURN
1320 IF C0 = 1 THEN STMP$ = "PASS":  GOSUB 20100: RETURN
1330 IF C0 = 2 THEN STMP$ = "MERIT": GOSUB 20100: RETURN
1340 IF C0 = 3 THEN STMP$ = "DIST":  GOSUB 20100: RETURN
1350 STMP$ = "N/A": GOSUB 20100
1360 RETURN

' NormalizePoint(p: Point): Point — record stack (pop->normalize->push)
1400 GOSUB 21010                 ' P_POP -> PXTMP,PYTMP
1410 IF PXTMP < 0 THEN PXTMP = -PXTMP
1420 IF PYTMP < 0 THEN PYTMP = -PYTMP
1430 GOSUB 21000                 ' P_PUSH normalized point
1440 RETURN

' Dist2(p: Point): integer — record in, numeric out
1500 GOSUB 21010                 ' P_POP -> PXTMP,PYTMP
1510 TMP = PXTMP * PXTMP + PYTMP * PYTMP
1520 GOSUB 20000                 ' N_PUSH result
1530 RETURN

' ========================= Stack runtime =========================

' Numeric stack: push expects TMP; pop -> TMP
20000 NSP = NSP + 1: NS(NSP) = TMP: RETURN
20010 TMP = NS(NSP): NSP = NSP - 1: RETURN

' String stack: push expects STMP$; pop -> STMP$
20100 SSP = SSP + 1: SS$(SSP) = STMP$: RETURN
20110 STMP$ = SS$(SSP): SSP = SSP - 1: RETURN

' Point stack: P_PUSH expects PXTMP,PYTMP; P_POP -> PXTMP,PYTMP
21000 PSP = PSP + 1: PXS(PSP) = PXTMP: PYS(PSP) = PYTMP: RETURN
21010 PXTMP = PXS(PSP): PYTMP = PYS(PSP): PSP = PSP - 1: RETURN

Notes

  • This BASIC stays within classic Bascom/Microsoft constraints: GOSUB/RETURN, scalar arrays, minimal line numbers, and no modern SUB/FUNCTION syntax.
  • The three stacks make the Pascal→Intermediate Representation→BASIC lowering mechanical: push args, GOSUB, pop returns.
  • Records are flattened to two arrays (PXS, PYS) for the Point stack; extend with more fields/types similarly.
  • Intermediate Representation is not shown

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.