$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 stat1
	statistics=0    ;1=yes, 0=no

sr4:    .word 0

function stat1[addr]

        mov addr(r5),r3	;addr of len/text...
        movb (r3)+,r0   ;len, r3-> text

        movb (r3),r2    ;1st char
        add r0,r3
        movb -(r3),r1	;get last char

        call hash

        movb htable(r1),r0	;r1 is position in table
        bic #177400,r0		;insure against signed number
        .if ne statistics
        printf "hash=%d table=%d" r1 r0
        .endc
        tst r0
        bne 3$
        ret		;its not in table, return zero
3$:
        dec r0
        mov #opword,r4          ;addrs of opcodes + 2
        mov #oplen,r3		;lens

        add r0,r3
        asl r0
        add r0,r4


5$:
        tst (r4)+
        movb @addr(r5),r0	;copy len of call
10$:
        cmpb r0,(r3)+		;len match?
        beq 20$			;yes, check text match
        tst (r4)+		;bump to next and check done
        bne 10$			;continue

        clr r0
        ret			;return not found

20$:
        mov -2(r4),r1		;get addr of opcode
        mov addr(r5),r0		;get addr of call opcode
        inc r0			;starts with count however
30$:
        movb (r0)+,r2
        movb (r1)+,-(sp)        ;two chars in r2 and (sp)
        beq 1015$		;lens match, and null is end of opcode, so a match
        cmpb (sp),#141
        blo 1005$
        cmpb (sp),#172
        bhi 1005$
        sub #40,(sp)		;convert case
1005$:
        cmpb r2,#141
        blo 1010$
        cmpb r2,#172
        bhi 1010$
        sub #40,r2		;convert case
1010$:
        cmpb (sp)+,r2		;compare chars
        beq 30$			;continue

        br 5$			;no match - check next

1015$:
        tst (sp)+		;pop off

        let r0 = r3 - #oplen
        ret			;return a match
tabset::
        mov .nopcodes,r4	;num of opcodes
        add mlcnt,r4		;plus number of macros
        mov r4,sr4
        mov #opword,r3		;addr of word table we will stuff
        mov #oplen,r2		;addr of len   "    "   "    "
        mov #.opcodes,r1	;addr of opcodes table
10$:
        len r1
        movb r0,(r2)+           ;set length of this opcode
        mov r1,(r3)+            ;set address of this opcode
        call hashit
        add r0,r1
        inc r1                  ;get to next opcode
        sob r4,10$              ;do em all (including macros)
        clr (r3)		;mark end with a null
        .if ne statistics
        call huh
        .endc
        rts pc




        auto size,sr1
function append[str1,str,n] ;n=0,1..n  if 0 str is asciz
        let r4 = str1 + #12.
        movb (r4)+,r3
        bic #177400,r3
        let r1 = r4 + r3
        let sr1 = r1
        if n = #0
            let r0 = str
10$:
            movb (r0)+,(r1)+
            bne 10$
            let r3 = r1 - r4 - #1
            movb r3,-(r4)
            ret r3
        else
            let r2 = fndstr[str,n]
            let r1 = sr1
            movb (r2)+,r0
            bic #177400,r0 ;len of str(n)
            let size = r0 + r3
            movb size(r5),-(r4)
            if r0 gt #0
20$:
                movb (r2)+,(r1)+
                sob r0,20$
            fi
        fi
        clr r0
        ret

hashit:
        push r1
        push r2
        push r3
        mov r1,r3
        movb (r1),r2 ;char 1 -> r2
        add r0,r1
        movb -1(r1),r1
        push r0
        call hash
        pop r0
        ifb htable(r1) = #0
            let r2 = sr4 - r4 + 1
            movb r2,htable(r1)
            .if ne statistics
            if swval ne 0
                printf "hash %-8s %4d = %d" r3 r1 r2
            fi
            .endc
        else
            .if ne statistics
            if swval ne 0
                printf "col at %-8s  %4d" r3 r1
            fi
            .endc
        fi
        pop r3
        pop r2
        pop r1
        rts pc

hash:
;+
; input  r0=length of string
;	 r1=char 1 of string
;	 r2=char n of string (last char)
;
; output r1 is hash value, r0 and r2 not restored
;
;-
;	printf " len=%d char1=%c charn=%c code=%s" r0,r2,r1,r3
        bic #177440,r1
        bic #177440,r2
        add r1,r2
        mul r2,r1	;mult chars together
        .if ne statistics
        if swval+2 ne 0
            printf "r0=%d r1=%d r2=%d" r0 r1 r2
        fi
        .endc
        mul r1,r0	;mult both together
        inc r0		;insure large number
        .if ne statistics
        if swval+2 ne 0
            printf "r0=%d r1=%d r2=%d" r0 r1 r2
        fi
        .endc
        div #prime,r0	;divide 32 bit result by prime number
        .if ne statistics
        if swval+2 ne 0
            printf "r0=%d r1=%d r2=%d" r0 r1 r2
        fi
        .endc
        rts pc

huh:
        .if ne statistics
        push r0
        push r1
        push r2
        push r3
        push r4

        clr r3
        clr r2
        loop for r4 = 0 to #prime-1
            if .htable[r4,b] = 0
                inc r3
            else
                inc r2
            fi
        next r4

        printf "used =%d free =%d sr4 = %d" r2 r3 sr4
        pop r4
        pop r3
        pop r2
        pop r1
        pop r0
        rts pc
        .endc
        .end