Source code in the algol programming language

# -*- coding: utf-8 -*- #
CO REQUIRES:
  MODE OBJVALUE = ~ # Mode/type of actual obj to be stacked #
END CO

MODE OBJNEXTLINK = STRUCT(
  REF OBJNEXTLINK next,
  OBJVALUE value # ... etc. required #
);

PROC obj nextlink new = REF OBJNEXTLINK:
  HEAP OBJNEXTLINK;

PROC obj nextlink free = (REF OBJNEXTLINK free)VOID:
  next OF free := obj stack empty # give the garbage collector a BIG hint #

# -*- coding: utf-8 -*- #
CO REQUIRES:
  MODE OBJNEXTLINK = STRUCT(
    REF OBJNEXTLINK next,
    OBJVALUE value
  );
  PROC obj nextlink new = REF OBJNEXTLINK: ~,
  PROC obj nextlink free = (REF OBJNEXTLINK free)VOID: ~
END CO

# actually a pointer to the last LINK, there ITEMs are ADDED, pushed & popped #
MODE OBJSTACK = REF OBJNEXTLINK; 

OBJSTACK obj stack empty = NIL;

BOOL obj stack par = FALSE; # make code thread safe #
SEMA obj stack sema = LEVEL ABS obj stack par;
# Warning: 1 SEMA for all stacks of type obj, i.e. not 1 SEMA per stack #

PROC obj stack init = (REF OBJSTACK self)REF OBJSTACK:
  self := obj stack empty;

# see if the program/coder wants the OBJ problem mended... #
PROC (REF OBJSTACK #self#)BOOL obj stack index error mended
  := (REF OBJSTACK self)BOOL: (abend("obj stack index error"); stop);

PROC on obj stack index error = (REF OBJSTACK self, PROC(REF OBJSTACK #self#)BOOL mended)VOID:
  obj stack index error mended := mended;

PROC obj stack push = (REF OBJSTACK self, OBJVALUE obj)REF OBJSTACK:(
  IF obj stack par THEN DOWN obj stack sema FI;
  self := obj nextlink new := (self, obj);
  IF obj stack par THEN UP obj stack sema FI;
  self
);

# aliases: define a useful put (+=:) operator... #
OP +=: = (OBJVALUE obj, REF OBJSTACK self)REF OBJSTACK: obj stack push(self, obj);

PROC obj stack pop = (REF OBJSTACK self)OBJVALUE: (
# DOWN obj stack sema; #
  IF self IS obj stack empty THEN
    IF NOT obj stack index error mended(self) THEN abend("obj stack index error") FI FI;

  OBJNEXTLINK old head := self;
  OBJSTACK new head := next OF self;
  OBJVALUE out := value OF old head;
  obj nextlink free(old head); # freeing nextlink, NOT queue! #
  self := new head;
#;UP obj stack sema; #
  out
);

PROC obj stack is empty = (REF OBJSTACK self)BOOL:
  self IS obj stack empty;

SKIP

# -*- coding: utf-8 -*- #
MODE DIETITEM = STRUCT(
  STRING food, annual quantity, units, REAL cost
);

# Stigler's 1939 Diet ... #
FORMAT diet item fmt = $g": "g" "g" = $"zd.dd$;
[]DIETITEM stigler diet = (
  ("Cabbage",           "111","lb.",  4.11),
  ("Dried Navy Beans",  "285","lb.", 16.80),
  ("Evaporated Milk",    "57","cans", 3.84),
  ("Spinach",            "23","lb.",  1.85),
  ("Wheat Flour",       "370","lb.", 13.33),
  ("Total Annual Cost",    "","",    39.93)
)

#!/usr/bin/a68g --script #
# -*- coding: utf-8 -*- #

MODE OBJVALUE = DIETITEM;
PR read "prelude/next_link.a68" PR;
PR read "prelude/stack_base.a68" PR;

PR read "test/data_stigler_diet.a68" PR;
OBJSTACK example stack; obj stack init(example stack);

FOR i TO UPB stigler diet DO
#  obj stack push(example stack, stigler diet[i]) #
  stigler diet[i] +=: example stack
OD;

printf($"Items popped in reverse:"l$);
WHILE NOT obj stack is empty(example stack) DO
# OR example stack ISNT obj stack empty #
  printf((diet item fmt, obj stack pop(example stack), $l$))
OD

MODE DIETITEM = STRUCT (
  STRING food, annual quantity, units, REAL cost
);
 
MODE OBJVALUE = DIETITEM;

# PUSH element to stack #
OP +:= = (REF FLEX[]OBJVALUE stack, OBJVALUE item) VOID:
   BEGIN
      FLEX[UPB stack + 1]OBJVALUE newstack;
      newstack[2:UPB newstack] := stack;
      newstack[1] := item;
      stack := newstack
   END;

OP POP = (REF FLEX[]OBJVALUE stack) OBJVALUE:
   IF UPB stack > 0 THEN
      OBJVALUE result = stack[1];
      stack := stack[2:UPB stack];
      result
   ELSE
      # raise index error; # SKIP 
   FI;

# Stigler's 1939 Diet ... #
FORMAT diet item fmt = $g": "g" "g" = $"zd.dd$;
[]DIETITEM stigler diet = (
  ("Cabbage",           "111","lb.",  4.11),
  ("Dried Navy Beans",  "285","lb.", 16.80),
  ("Evaporated Milk",    "57","cans", 3.84),
  ("Spinach",            "23","lb.",  1.85),
  ("Wheat Flour",       "370","lb.", 13.33),
  ("Total Annual Cost",    "","",    39.93)
);

FLEX[0]DIETITEM example stack;
 
FOR i TO UPB stigler diet DO
   example stack +:= stigler diet[i]
OD;
 
printf($"Items popped in reverse:"l$);
WHILE UPB example stack > 0 DO
  printf((diet item fmt, POP example stack, $l$))
OD