PROGRAM demo; (* Pascal 800 / Jan-Olof Svensson <6057> *)
TYPE Str80 = String(.80.);
     ItemPtr = ^Item;
     Item = RECORD
              txt:Str80;
              next:ItemPtr;
            END;
VAR top:ItemPtr;

PROCEDURE Clrscr; EXTERNAL;

PROCEDURE Introduce;
BEGIN
  Clrscr;
  Writeln('H{r f|ljer en demonstration av hur man kan anv{nda');
  Writeln('dynamiska variabler. Det fungerar p} s} s{tt att EN');
  Writeln('identifierare anknyts till FLERA data-areor som man');
  Writeln('n}r via pekare. Programmet skapar allts} nya variabler');
  Writeln('allt efter behov.');
  Writeln('I det h{r fallet bildas en l{nkad lista av str{ng-');
  Writeln('variabler men det skulle lika g{rna kunna vara heltal,');
  Writeln('vektorer, poster eller n}gonting annat.');
  Writeln;
  Writeln('Du kan nu skriva valfritt antal rader. N{r du sedan');
  Writeln('avslutar med att bara trycka Return s} skrivs alla');
  Writeln('raderna ut, och variablerna tas bort ur minnet.');
  Writeln;
END; (* Introduce *)

PROCEDURE Push(data:Str80; VAR top:ItemPtr);
VAR tmp:ItemPtr;
BEGIN
  IF MemAvail > 500 THEN BEGIN
    New(tmp);
    tmp^.txt:=data;
    tmp^.next:=top;
    top:=tmp;
  END
  ELSE
    Writeln('Stack overflow!');
END; (* Push *)

PROCEDURE Pop(VAR data:Str80; VAR top:ItemPtr);
VAR tmp:ItemPtr;
BEGIN
  IF top<>NIL THEN BEGIN
    data:=top^.txt;
    tmp:=top;
    top:=top^.next;
    Dispose(tmp);
  END
  ELSE
    Writeln('Stack underflow!');
END; (* Pop *)

PROCEDURE SwapItems(VAR top:ItemPtr); (* Not used in this program *)
VAR tmp:ItemPtr;
    ok:Boolean;
BEGIN
  ok:=False;
  IF top<>NIL THEN
    IF top^.next<>NIL THEN BEGIN
      tmp:=top^.next;
      top^.next:=tmp^.next;
      tmp^.next:=top;
      top:=tmp;
      ok:=True;
    END;
  IF NOT ok THEN
    Writeln('Stack error!');
END; (* SwapItems *)

PROCEDURE MakeList(VAR top:ItemPtr);
VAR workline:Str80;
BEGIN
  Writeln(']terst}ende minne: ',MemAvail*2,' bytes. ',
          'Skriv en text (max 80 tecken):');
  Readln(workline);
  WHILE NOT (workline='') DO BEGIN
    Push(workline,top);
    Writeln(']terst}ende minne: ',MemAvail*2,' bytes. ',
            'Skriv en text (max 80 tecken):');
    Readln(workline);
  END;
END; (* MakeList *)

PROCEDURE Reverse(VAR top:ItemPtr); (* Reverse by linking to new list *)
VAR newTop,tmp:ItemPtr;
BEGIN
  newTop:=NIL;
  WHILE top <> NIL DO BEGIN
    tmp:=top^.next;
    top^.next:=newTop;
    newTop:=top;
    top:=tmp;
  END;
  top:=newTop;
END; (* Reverse *)

PROCEDURE WriteList(VAR top:ItemPtr);
VAR workline:Str80;
BEGIN
  WHILE top <> NIL DO BEGIN
    Pop(workline,top);
    Writeln(workline);
  END;
END; (* WriteList *)

BEGIN (* demo *)
  Introduce;
  top:=NIL;
  MakeList(top);
  Clrscr;
  Reverse(top);
  WriteList(top);
END.