$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 DOO FUN
        MOV ##@1,f1(r5)
        MOV R3,-(SP)
        MOV R4,-(SP)
        MOV R5,-(SP)
        mov r5,r0
        add #prm,r0
        mov r0,r5
        JSR PC,UTIL
        MOV (SP)+,R5
        MOV (SP)+,R4
        MOV (SP)+,R3
        TST (SP)+
        $ENDM
/
        PROGRAM UTIL2
        SETLAB UT$

;-
; main segment routines - all recursive, so they must be on same
; overlay branch.
;
;+



;        AUTO prm[12.]  p4 p3 p2 p1 f1 count
;FUNCTION state[string]
;        jsr pc,parms
;        mov string(r5),p1(r5)
;        DOO 2
;        RET



state:: jmp newstat     ;new routine but old name still is used this way

        AUTO prm[12.]  p4 p3 p2 p1 f1 count
FUNCTION outst[string]       ;output string non-recursively
        LET p1 = string
        jsr pc,parms
        DOO 3
        RET


        AUTO prm[12.]  p4 p3 p2 p1 f1 count
FUNCTION strng[smp,sas]      ;copy "string" into smp type see mvstr notes
        mov smp(r5),r0       ;on type of the smp string after this operation
        add #12.,r0
        mov r0,r4
        mov sas(r5),r1
        clrb (r0)+	;init len
        DO FOREVER
            movb (r1)+,(r0)+
            IF EQ
                BREAK
            FI
        OD
        mov r0,r3	;length of string computation
        sub r4,r3
        sub #2,r3	;length
        movb r3,(r4)
        RET

        AUTO prm[12.]  p4 p3 p2 p1 f1 count
FUNCTION instr[smp,dim]      ;init smp string to string array of dim elements
        LET p1 = smp
        LET p2 = dim
        jsr pc,parms
        DOO 9.
        RET

        AUTO prm[12.]  p4 p3 p2 p1 f1 count
FUNCTION expand[s,smp,p]     ;expand "s" into smp, p = pointer to
        ALL r4               ;an s,t,n,l 4 word array
        . strng[r4,s]
        LET r3 = p
        LET r0 = 4(r3) - #1
        mov 6(r3),r2
        IF r2 LT #0
            mov #1,r2
            dec r0
        ELSE
            clr r2
        FI
        inc r2
        . subs[2(r3),r0,#-1,smp,r4,r2]
        FRE
        RET

        AUTO prm[12.]  p4 p3 p2 p1 f1 count
FUNCTION toks[smp,tmp]       ;break up smp into tokens into tmp (20 element
        LET p1 = smp         ; smp type string.
        LET p2 = tmp         ;returns number of tokens
        jsr pc,parms
        DOO 5
        RET p3

        AUTO prm[12.]  p4 p3 p2 p1 f1 count
FUNCTION toksl[smp,tmp]      ;same as toks, but if a label was present, then
        LET p1 = smp         ;it adds 100 to the number of toks returned
        LET p2 = tmp         ; (just sub the 100 to get real result but
        jsr pc,parms         ; note there was a label also)
        DOO 5
        IF p4 NE #0
            RET p3 + #100.
        ELSE
            RET p3
        FI

        AUTO prm[12.]  p4 p3 p2 p1 f1 count
FUNCTION stack[smp,n]        ;put smp into stack at location n
        LET p2 = smp
        LET p1 = n
        jsr pc,parms
        DOO 6
        RET


        AUTO prm[12.]  p4 p3 p2 p1 f1 count
FUNCTION labl[n,p]           ;generate a label an put it in parm n
        LET r3 = p           ;p -> s,t,n,l array
        mov 2(r3),p1(r5)
        LET p3 = n
        IF 6(r3) GE #0
            inc p3(r5)
        ELSE
            add #2.,p3(r5)
        FI
        ALL p2(r5)
        jsr pc,parms
        DOO 7
        FRE
        RET

        AUTO prm[12.]  p4 p3 p2 p1 f1 count
FUNCTION copy[s1,i1,s2,i2]   ;general copy, s1 and s2 cannot be in the
        LET p1 = s1          ;same smp type array. s1(i1) = s2(i2)
        LET p2 = i1
        LET p3 = s2
        LET p4 = i2
        jsr pc,parms
        DOO 10.
        RET



parms:  				;this sets up an old style calling sequence
        mov r5,r0            ; (fortran type) for the fosilized routines
        add #f1,r0           ; still being used somewhere in this program
        mov r5,r1
        add #prm,r1
        mov #4,(r1)+
        mov r0,(r1)+
        tst (r0)+
        mov r0,(r1)+
        tst (r0)+
        mov r0,(r1)+
        tst (r0)+
        mov r0,(r1)+
        tst (r0)+
        mov r0,(r1)+
        tst (r0)+
        rts pc
INI::   				;this code initializes an smp type string
        mov 2(sp),r0
        mov (sp),2(sp)
        add #2,sp
        mov 2(sp),6(sp)
        sub #12.,6(sp)
        mov #255.,8.(sp)
        clr 10.(sp)
        mov #1,12.(sp)
        clr 14.(sp)
        rts pc


FUNCTION isexp[t,i]          ;is t(i) an expression, <a + b> type
        LET r4 = fndstr[t,i]
        IFB (r4) = #1
            SELECT case 1(r4) of
            CASEB #'+ OR
            CASEB #'* OR
            CASEB #'/ OR
            CASEB #'-
                RET #1
            ESAC
        FI
        RET #0


FUNCTION ifrec1[s]           ; is s a recursive string
        LET r4 = s           ;here is all the dirty work
        movb(r4)+,r3
        bic #177400,r3
        LOOP for r2 = #1 TO r3
            movb (r4)+,r0
            SELECT case r0 of
            CASEB #comma OR
            CASEB #blsep OR
            CASEB #lbr OR
            CASEB #rbr OR
            CASEB #tabsp
                RET #1
            ESAC
        NEXT r2
        RET #0


        AUTO sign,c,i
FUNCTION valx[s,base]        ;takes s ( fndstr[t,n] output) with a base
        clr c(r5)            ; 1-10 and returns a signed binary value
        mov #1,sign(r5)
        mov s(r5),r0
        movb (r0)+,c(r5)
        clr r3
        LOOP for i = #1 TO c
            IFB (r0) = #'-
                neg sign(r5)
                inc r0	;next char
            ELSEIFB (r0) = #'+
                inc r0
            ELSE
                movb (r0)+,r2
                BIC #177400,r2
                LET r3 = r3 * base + r2 - #'0
            FI
        NEXT i
        RET r3 * sign


        .end