Below is a single document that contains:
- a restricted Turbo-Pascal-style program (stack-friendly), and
- 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 pointerNSP
; push via20000
, pop via20010
. - String stack
SS$()
with pointerSSP
; push via20100
, pop via20110
. - “Record” stack for
Point(x,y)
viaPXS()
,PYS()
with pointerPSP
; push21000
, pop21010
. - 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 modernSUB/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 thePoint
stack; extend with more fields/types similarly. - Intermediate Representation is not shown