MODULE ptest;

TYPE Plist = POINTER TO Tlist;
     Tlist = RECORD
	a: WORD;
	next: Plist; 
     END;
      
VAR Hlist, Gcoll: Plist;

  PROCEDURE* ISR[BTRAP]; (* Class-B-Trap *)
  VAR v, w: WORD;
  BEGIN w := TFR; v := w;
   IF (w ANDB 4) # 0 THEN (* ILLOPA? *)
      w := SP; Peekw(w, 0);
      Writeln("Pointer = NIL @ $", w:h);
      (* Flag loeschen *)
      v := v ANDB ($FFFF - 4); TFR := v;
    END;
    REPEAT Sleep UNTIL 1 = 2;
  END ISR;  
  
  PROCEDURE* Remove(VAR head: Plist; val: WORD);
  VAR p, h: Plist;
  BEGIN p:= head;
    IF head # NIL THEN
      IF head.a = val THEN
	head := head.next; p.next := Gcoll; Gcoll := p;
      ELSE
	WHILE (p.next # NIL) & (p.next.a # val) DO
	  p := p.next; END;
	IF p # NIL THEN
	  h := p.next; p.next := h.next; 
	  h.next := Gcoll; Gcoll := h;
	END;
      END;
    END;
  END Remove;
  
  PROCEDURE* Ontop(VAR head: Plist; val: WORD);
  VAR p: Plist;
  BEGIN
    IF Gcoll # NIL THEN
      p := Gcoll; Gcoll := Gcoll.next;
    ELSE 
      NEW(p); Writeln("NEW required");
    END;
    p.a := val; p.next := head; head := p;
  END Ontop;
  
  PROCEDURE* create(VAR head: Plist);;
  VAR p: Plist; i: WORD;
  BEGIN 
    FOR i := 0 TO 15 DO
      NEW(p); p.a := i; p.next := head; head := p;
    END;
  END create;
  
  PROCEDURE* test(head: Plist);
  VAR p: Plist; w: WORD;
  BEGIN p := head;
    WHILE p # NIL DO
      Write(p.a); Write( ", "); p := p.next;
    END;
    Writeln("NIL");
     (*w := p.a;*)
  END test;

  PROCEDURE* start;
  VAR k: Plist;
  BEGIN k := NIL;
    Writeln("HeapTop: $", _HeapTop:h);
    create(k); Hlist := k; 
    Writeln("HeapTop: $", _HeapTop:h);
    test(k);
    Remove(k, 7);
    test(k);
    Ontop(k, 7);
    test(k);
  END start;

BEGIN Hlist := NIL; Gcoll := NIL; start;
  Writeln("Returned!");
  REPEAT Sleep; UNTIL 1 = 2;
END ptest.

(*
HeapTop: $E018
HeapTop: $E058
15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0, NIL
15, 14, 13, 12, 11, 10, 9, 8, 6, 5, 4, 3, 2, 1, 0, NIL
7, 15, 14, 13, 12, 11, 10, 9, 8, 6, 5, 4, 3, 2, 1, 0, NIL
Returned! *)