shogun/pstack.zabstr

<ZZPACKAGE "PSTACK"> 
<ENTRY ALLOCATE-PSTACK MAX-PSTACK-SIZE PUSH-PSTACK POP-PSTACK PEEK-PSTACK
PSTACK FLUSH-PSTACK PSTACK-PTR CLEAR-PSTACK PSTACK-DATA PSTACK-EMPTY?> 
<USE "NEWSTRUC"> 
<FILE-FLAGS> 
<BEGIN-SEGMENT 0> 
<MSETG MAX-PSTACK-SIZE 21> 
<NEWTYPE PSTACK TABLE> 
<DEFMAC ALLOCATE-PSTACK () <ITABLE ,MAX-PSTACK-SIZE 0>> 
<DEFMAC PSTACK-PTR ('S "OPT" 'NEW) <COND (<ASSIGNED? NEW> <FORM ZPUT .S 0 .NEW>
) (T <CHTYPE [<FORM ZGET .S 0> FIX] ADECL>)>> 
<DEFMAC PSTACK-EMPTY? ('PSTACK) <COND (<CHECK-VERSION? YZIP> <FORM EQUAL? <- ,
MAX-PSTACK-SIZE 1> <FORM PSTACK-PTR .PSTACK>>) (T <FORM 0? <FORM PSTACK-PTR .
PSTACK>>)>> 
<DEFMAC CLEAR-PSTACK ('S) <COND (<CHECK-VERSION? YZIP> <FORM PSTACK-PTR <CHTYPE
[.S PSTACK] ADECL> <- ,MAX-PSTACK-SIZE 1>>) (T <FORM PSTACK-PTR <CHTYPE [.S
PSTACK] ADECL> 0>)>> 
<DEFINE20 PRINT-PSTACK (S:PSTACK "OPT" (OUTCHAN:CHANNEL .OUTCHAN) "AUX" (P <
PSTACK-PTR .S>)) <PRINT-MANY .OUTCHAN PRINC "#PSTACK [" .P " ["> <REPEAT ((D <
ZREST .S 2>)) <COND (<L=? .P 0> <RETURN>)> <PRIN1 <ZGET .D 0>> <PRINC " "> <SET
D <ZREST .D 2>> <SET P <- .P 1>>> <PRINC "]]">> 
<COND (<CHECK-VERSION? YZIP> <DEFMAC PUSH-PSTACK ('S 'OBJ) <FORM XPUSH .OBJ .S>
>) (T <IF-P-DEBUGGING-PARSER <GLOBAL PSTACK-WARN:NUMBER 20>> <ROUTINE
PUSH-PSTACK (S:PSTACK OBJ "AUX" TMP) <SET TMP <+ 1 <PSTACK-PTR .S>>> <COND (<
L=? ,MAX-PSTACK-SIZE .TMP> <P-NO-MEM-ROUTINE> <RFALSE>)> <IF-P-DEBUGGING-PARSER
<COND (<L? ,PSTACK-WARN .TMP> <SETG PSTACK-WARN .TMP> <PRINTI "[PSTACK: "> <
PRINTN <- ,MAX-PSTACK-SIZE .TMP>> <PRINTI " left!]|">)>> <PSTACK-PTR .S .TMP> <
ZPUT .S .TMP .OBJ> .S>)> 
<COND (<CHECK-VERSION? YZIP> <DEFMAC FLUSH-PSTACK ('S "OPT" ('N 1)) <FORM
FSTACK .N .S>>) (T <ROUTINE FLUSH-PSTACK (S:PSTACK "OPT" (N:FIX 1)) <COND (<G?
0 <SET N <- <PSTACK-PTR .S> .N>>> <SET N 0>)> <PSTACK-PTR .S .N> .S>)> 
<COND (<CHECK-VERSION? YZIP> <DEFMAC POP-PSTACK ('S "OPT" ('N 1)) <COND (<1? .N
> <FORM POP .S>) (T <FORM FSTACK .N .S>)>>) (T <ROUTINE POP-PSTACK (S:PSTACK
"OPT" (N:FIX 1) "AUX" (OBJ <PEEK-PSTACK .S>)) <COND (<NOT <0? .N>> <
FLUSH-PSTACK .S .N>)> .OBJ>)> 
<COND (<CHECK-VERSION? YZIP> <ROUTINE PEEK-PSTACK (S "OPT" (OFFS 0) "AUX" (N 0)
VAL) <REPEAT () <SET VAL <POP .S>> <PUSH .VAL> <SET N <ADD N 1>> <COND (<LESS?
<SET OFFS <SUB OFFS 1>> 0> <RETURN>)>> <REPEAT () <COND (<LESS? <SET N <SUB N 1
>> 0> <RETURN>) (T <XPUSH #ZLOCAL!-IZILCH STACK .S>)>> .VAL>) (T <ROUTINE
PEEK-PSTACK (S:PSTACK "OPT" (OFFS:FIX 0)) <ZGET .S <- <PSTACK-PTR .S> .OFFS>>>)
> 
<DEFINE-ROUTINE PEEK-PSTACK> 
<END-SEGMENT> 
<ENDPACKAGE>