        $MACRO PRINTF
        mov r0,-(sp)
        mov r1,-(sp)
        PRINTS #@1 <#@2><#@3><#@4><#@5><#@6><#@7><#@8><#@9><#@A><#@B><#@C><#@D>
        TYPE #@1
        mov (sp)+,r1
        mov (sp)+,r0
        $ENDM 
; move comments over 1 tab	C/;/	;/
; move back 1 tab        	C/	;/;/
        $MACRO return	;this MUST be lower case
        rts pc
        $ENDM 
/
        PROGRAM Ea 	;Utility routines module 2
        mutask=1 
        .psect edi10
        .enabl lc
        .enabl ama
        .nlist sym
                
        .if df mutask
        .MACRO pure
        .psect pur,ro
        .ENDM 
                
        .MACRO impure
        .psect ipur,rw
        .ENDM 
                
        .iff 
                
        .MACRO pure
        .ENDM 
        .MACRO impure
        .ENDM 
                
        .endc 
        .globl caseck	;check for &\x options in substitute command
        .globl marktg   ;mark tags
        .globl marktd   ;mark tags delete entry
        .globl retag    ;restore tags after operation
                
        .MACRO push this
        mov this,-(sp)
        .ENDM 
                
        .MACRO pop that
        mov (sp)+,that
        .ENDM 
                
                
; - - -	 macro library calls
                
                
        .mcall dir$,callr
                
                
; - - -	 system	macros
                
                
                
; - - -	 local data and	symbols
s1:     .word           ;save padr1
s2:     .word           ;save padr2
one:    .word           ;compute address of line 1
;temp:   .blkb  100.     ;temp
                
        pure 
                
                
                
;+
;
; This routine checks for various & options in the substitute
; command.
;
; currently, the options are:
;
;		&\u	convert to upper case
;		&\l	convert to lower case
;		&\t	toggle case
;		&\r	reverse all characters (not yet, but maybe)
;
;   If there is a \ followed by a valid char (one of above) then
;   we  either  do  it all here (going thru sstore ourselves) in
;   which case we set the carry bit on return, or  we  don't  do
;   nothin (indicated, of course, by a clear carry bit). 
; So...
;	Input: r0,r2,r3,r4,r5, and all other stuff local to the sub cmd
;	Output: carry bit with all the regs updated as in sub  or
;	        carry clear with nothing changed.
;
;-
caseck:  
        IFB (r4) = #'\	;is it us
            push r1
            inc r4
            movb (r4)+,r1		;get next char
            bic #177600,r1		;7 bit ascii only
            IF r1 = #0			;test for end of buf
10$:            sub #2,r4		;and retrace our steps
                pop r1
                clc			;didn't do nuthin
                return 
            ELSE 
                bic #40,r1		;make it upper case
                SELECT case r1 of
                CASE #'L
                    call csL
                    BREAK 
                CASE #'U
                    call csU
                    BREAK 
                CASE #'T
                    call csT
                    BREAK 
                CASE #'R
                    call csR
                    BREAK 
                DEFAULT 
                    br 10$
                ESAC 
            FI 
            pop r1
            sec 
            return 
        FI 
        clc 
        return 
                
; - - -   toggle case
                
                
        .if eq 0                ;is implemented again
csT:    				;toggle case
        MOV	R4,-(SP)	;SAVE R.H.S. POINTER
        MOV	R2,R4		;POINTER TO WHAT MATCHES
136$:   CMP	R4,R0		;DONE ?
        BHIS	139$		;YES
        MOVB	(R4)+,R5	;GET CHARACTER
        CMP	R5,#'A		;UPPER CASE ?
        BLO	138$		;NO
        CMP	R5,#'Z		;PERHAPS ?
        BHI	137$		;NO
        BIS	#' ,R5		;FORCE LOWER
        BR	138$		;
137$:   CMP	R5,#'a		;LOWER CASE ?
        BLO	138$		;NO
        CMP	R5,#'z		;PERHAPS ?
        BHI	138$		;NO
        BIC	#' ,R5		;FORCE UPPER
138$:   CALL	SSTORE		;STORE R.H.S. CHARACTER
        BR	136$		;
139$:      
        pop r4
        return 
        .endc 
                
; - - -    force all to lower
                
                
csL:        
        MOV	R4,-(SP)	;SAVE R.H.S. POINTER
        MOV	R2,R4		;POINTER TO WHAT MATCHES
136$:   CMP	R4,R0		;DONE ?
        BHIS	139$		;YES
        MOVB	(R4)+,R5	;GET CHARACTER
        CMP	R5,#'A		;UPPER CASE ?
        BLO	138$		;NO
        CMP	R5,#'Z		;PERHAPS ?
        BHI	138$		;NO
        BIS	#' ,R5		;FORCE LOWER
138$:   CALL	SSTORE		;STORE R.H.S. CHARACTER
        BR	136$		;
139$:      
        pop r4
        return 
                
; - - -    force all to UPPER
                
csU:        
        MOV	R4,-(SP)	;SAVE R.H.S. POINTER
        MOV	R2,R4		;POINTER TO WHAT MATCHES
136$:   CMP	R4,R0		;DONE ?
        BHIS	139$		;YES
        MOVB	(R4)+,R5	;GET CHARACTER
        CMP	R5,#'a		;lower CASE ?
        BLO	138$		;NO
        CMP	R5,#'z		;PERHAPS ?
        BHI	138$		;NO
        bic	#' ,R5		;FORCE UPPER
138$:   CALL	SSTORE		;STORE R.H.S. CHARACTER
        BR	136$		;
139$:      
        pop r4
        return 
                
                
; - - - 	reverse string
csR:        
        push r4
        mov r0,r4
136$:   cmp r4,r2	;done?
        blos 139$	;yes
        movb -(r4),r5
        call sstore
        br 136$
139$:      
        pop r4
        return 
                
                
; - - - unimplemented stuff
                
        .if eq 1
;;csT:	
        sub #2,r4
        add #2,sp
        pop r1
        clc 
        return			;this retracts each of these commands
                
        .endc 
                
marktd:  
        call saval
        LET one = zero + #2
        IF adr1 = adr2
            IF padr1 = adr1  AND  padr1 LO dol
                add #2,padr1
            ELSEIF padr2 = adr1 AND padr2 HI one
                sub #2,padr2
            FI 
        FI 
        br mar1
marktg:  
        call saval
mar1:   mov #1,s1
        mov #1,s2
        IF padr1 NE #0  AND  padr2 NE #0
            LET one = zero + #2
            IF padr1 HIS one  AND  Padr1 LOS dol
                mov @padr1,s1
                IF padr2 HIS padr1   AND  padr2  LOS dol
                    mov @padr2,s2
                ELSE 
                    mov #1,s2
                    mov #1,s1
                FI 
            ELSE 
                mov #1,s2
                mov #1,s1
            FI 
        FI 
;PRINTF #temp <before retag s1=%o s2=%o padr1=%o padr2=%o> s1 s2 padr1 padr2
        rts pc
                
                
retag:    
        call saval
;PRINTF #temp <s1=%o s2=%o padr1=%o padr2=%o> s1 s2 padr1 padr2
;PRINTF #temp <dot=%o zero=%o dol=%o> dot zero dol
;PRINTF #temp <adr1=%o adr2=%o> adr1 adr2
        IF s1 = #1  OR  s2 = #1
            br clear
        FI 
        mov s1,r0
        call findpt
        bcs clear
                
        mov r1,padr1
        mov s2,r0
        call findpt
        bcs clear
                
        mov r1,padr2
        rts pc
                
clear:    
        clr padr1
        clr padr2
        rts pc
                
                
findpt:  
        LOOP for r1 = one THRU dol STEP #2
            IF r0 = (r1)
                                
;	      PRINTF #temp <returning sucess from findpt r0=%o r1=%o> r0 r1
                clc 
                rts pc
            FI 
        NEXT r1
;        PRINTF #temp <returning failure from findpt r0=%o> r0
        sec 
        rts pc
                
        .end 
