        $MACRO ALL VAR
        JSR PC,$$RES
        RES.STR #@{1} @#$$RES1
        $ENDM
; - - - - - - - - - - - - - - - - - - - - - - -
        $MACRO FRE
        MOV (SP),R0
        ADD R0,SP
        $ENDM
; - - - - - - - - - - - - - - - - - - - - - - -
        $MACRO RES.STR ;  NAME,SIZE
        SUB #@2,SP
        SUB #10.,SP
        MOV #1,-(SP)
        MOV #@2,-(SP)
        ADD #8.,(SP)
        MOV SP,#@1
        MOV #@1,-(SP)
        JSR PC,INI
        ADD #6.,(SP)
        JSR PC,$$$STK
        $ENDM
; - - - - - - - - - - - - - - - - - - - - - - -
        $MACRO print
        ** p%%t <#@*(1"Z)>
        $ENDM
; - - - - - - - - - - - - - - - - - - - - - - -
        $MACRO p%%t
        printf "#@1=%d. %o" <#@1> <#@1>
        $ENDM
; - - - - - - - - - - - - - - - - - - - - - - -
        $MACRO LEN string
?? 2
        mov #@{1},r0
        #@2=.
        tstb (r0)+
        bne #@2
        sub #@{1},r0
        dec r0
        $ENDM
/
        program stat2

;
; tables for determining actions. All 4 stack ops are similar or symetric
; so there are only a few actions which need to be performed.
;
; argsf is used to evaluate all args as integers, but pushes don't
; have a number in arg 1 (they have a string)
;
; sps maps function code into which stack we operate on
;
; dir is plus or minus for whether the function  is to or from stack
; used by the transfer routine.
;
; pp is -2,-1,0,1,2 for whether the function is a push or pop and
; which stack. otherwise its really a move to/from
;
;
; arg is used to determine what argument value determines the
; ultimate stack location (string stack).
;
; cons is a constant added to arg above, to compute string stack location.
;
; argsf,sps,dir are indexed by the func code (parm 1 to this routine)
; the first item is not used so we can index starting at 1 (not 0)
;
; arg,cons are indexed by code which is computed by considering
; which type of opcode and whether it is push/pop, relative-to-sp, or
; absolute. The result produces a value of 0-11.
;
argsf:  .byte 0,3,2,3,2
dir:    .byte 0,-1,1,-1,1

pp:     .byte -1,0,0  ,1,0,0  ,-2,0,0 ,2,0,0
sps:    .byte  1,1,0,   1,1,0,  2,2,0,   2,2,0
arg:    .byte 0,1,2  ,0,1,2  ,0,1,2  ,0,1,2
cons:   .byte 0,1,0  ,0,1,0  ,0,1,0  ,0,1,0
        .even


        auto n4,n3,n2,n1,values[0]
        auto from,nn4,ctrue,ll,nn,tt,ss
        auto t1,t2,t3,stkloc,t5
function stkops[func,s,t,n,l]	 ;handle stack ops ??, ?- ?-- ?+ ?++

        ltype=r2
        code=r3

        zero n1,n2,n3,n4,code,ltype
        if func = #0
            call context	;get macro context into ss,tt,nn,ll
            loop for r4 = #2 to n
                let r3 = valx[fndstr[t,r4],#10.]
                if r3 gt #0 and r3 lt #25.
                    . labl[r3,&ss]
                fi
            next r4
        else
            call getargs
            call typex
            call condit
            if ctrue  ne #0
                call pushx

                call  context
                call fetch
                call transfer

                call popx

            fi

        fi
        ret
getargs:
        let from = .argsf[func,b]
        loop for r4 = from to n
            leta .values[<r4 - #2>] = valx[fndstr[t,r4],#10.]
        next r4

        rts pc
typex:
        if n3 ne #0 and n ge #3
            let ltype = #3
        elseif n2 ne #0 and n ge #2
            let ltype = #2
        else
            let ltype = #1
        fi
        let code = func - #1 * #3 + ltype - #1
        rts pc
condit:
        let ctrue = #1	;condition assumed true
        if n4 ne #0 and n gt #3
            let nn4 = n4
            if nn4 lt #0
                neg nn4(r5)
            fi
            let r4 = .swval[<nn4 - #1>]
            if r4 = #0 and n4 gt #0
                zero ctrue
            fi
            if r4 ne #0 and n4 lt #0
                zero ctrue
            fi
        fi
        rts pc
pushx:
        call gp
        select case r4 of
        case #-1
            inc sp1
            break
        case #-2
            inc sp2
            break
        esac
        call over
        rts pc
fetch:  				;compute stack index we go to or from
        let r4 = .sps[code,b]
        select case r4 of
        case #1
            let t1 = sp1
            break
        case #2
            let t1 = sp2 + #$cnt2
            break
        default
            zero t1
        esac
        let t2 = .arg[code,b]
        if t2 ne #0
            let t3 = .values[t2]
        else
            zero t3
        fi
        let t5 = .cons[code,b]
        if t5 ne #0
            neg t3(r5)
        fi
        let stkloc = t1 + t3 + t5
        rts pc
transfer:
        if .dir[func,b] lt #0	;its a push or move to stack
            . copy[#$stack,stkloc,t,#2]
            else		;pop or move from stack
            if stkloc gt #0 and n1 gt #0
                . copy[tt,<n1 + #1>,#$stack,stkloc]
            fi
        fi
        rts pc
popx:
        call gp
        select case r4 of
        case #1
            dec sp1
            break
        case #2
            dec sp2
            break
        esac
        call over
        rts pc
gp:
        let r4 = .pp[code,b]
        rts pc
context:
        if mlsp = #mlstk-2
            let ss = s
            let tt = t
            let nn = n
            let ll = l
        else
            mov @mlsp,r0
            let ss = (r0)+
            let tt = (r0)+
            let nn = (r0)+
            let ll = (r0)
        fi
        rts pc
over:
        if sp1 lt #0  or  sp1 gt #25. or sp2 lt #0 or sp2 gt #29.
            . exstat["i%err <fatal stack under/over flow #@0>",&s,#0]
            zero sp1,sp2
        fi
        rts pc
        .end
