Sync

Task/Stack/ALGOL-68/stack-1.alg

@@ -0,0 +1,15 @@
+# -*- 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 #

Task/Stack/ALGOL-68/stack-2.alg

@@ -0,0 +1,57 @@
+# -*- 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

Task/Stack/ALGOL-68/stack-3.alg

@@ -0,0 +1,15 @@
+# -*- 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)
+)

Task/Stack/ALGOL-68/stack-4.alg

@@ -0,0 +1,20 @@
+#!/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