; move comments over 1 tab	C/;/	;/
; move back 1 tab        	C/	;/;/
        $MACRO return	;this MUST be lower case
        rts pc
        $ENDM 
/
        PROGRAM e9 	;Utility routines
        control.a=1		;control a ascii char
        .psect edi09,rw
        mutask=1 
        .enabl lc
         
        .if df mutask
        .MACRO pure
        .psect pur,ro
        .ENDM 
         
        .MACRO impure
        .psect ipur,rw
        .ENDM 
         
        .iff 
         
        .MACRO pure
        .ENDM 
        .MACRO impure
        .ENDM 
         
        .endc 
        .globl tcom				;entry for t command
        .globl ycom				;entry for y command
        .globl morecore				;get more memory
        .globl macrop				;macro processor entry
        .globl nonull				;change nulls to 377's
        .globl ranges				;[a-z] type char class check
         
        .MACRO push this
        mov this,-(sp)
        .ENDM 
         
        .MACRO pop that
        mov (sp)+,that
        .ENDM 
         
         
; - - -	 macro library calls
         
         
        .mcall extk$,dir$,callr
         
         
; - - -	 system	macros
         
         
ex:     extk$	2		;get	64 words
         
; - - -	 local data and	symbols
         
        tab	=	11
         
ipeek:  .word			;internal get	char peek word
iptr:   .word			;buffer pointer for the get char
iadr:   .word			;address of start of macro
char:   .word			;a single char to be putback
         
        pure 
         
lowasc: .byte 2,3,4,5,6		;invisible char table
        .byte 10,13,14,16,17	;The code assumes these are fixed
        .byte 20,21,22,23,24,25,26,27,30 ;since it needs to know how
        .byte 31,32,34,35,36,37,177 ;when a char is one of these
        elow=.-lowasc			;This it does by arithmetic below
         
        .even 
         
; - - -	 t command processor
         
         
tcom:    
        call nonzero
        call getc
        bic #40,r0			;to upper	case
        SELECT case R0 of
             
        CASE #nl
            mov r0,peek		;put	it back
            mov adr1,padr1		;set both	 to entered addresses
            mov adr2,padr2
            return 
        CASE #'T
            tst padr1			;must have valid previous addresses
            bne 2$
            tst padr2
            bne 2$			;as long	as non zero, were ok (so far)
1$:         mov #15.,r1		;error of bad addresses
            jmp error
2$:          
            IF padr2 LO padr1		;check for bad range
                br 1$
            FI 
             
            IF adr2 HIS padr2		;is it an upper	bound
                mov adr2,padr2;yes
                return 
            FI 
             
            IF adr2 LOS padr1		;is it a lower bound
                mov adr2,padr1	;yes
                return 
            FI 
             
            LET r0 = adr2 - padr1	;find the closest
            LET r1 = padr2 - adr2	;or	second of t,tt command pair
             
            IF r1 LT r0
                mov adr2,padr2
            ELSE 
                mov adr2,padr1
            FI 
            return 
        CASE #'U
            mov adr2,padr1
            return 
        DEFAULT 
            mov adr2,padr2
            return 
        ESAC 
         
         
         
         
; - - -	morecore	get more core
         
morecore:  
        dir$ #ex		;extend task
        bcc 10$		;skip if got	it
5$:     mov #11.,r1		;else too	many lines error
        jmp error		;go	to it
10$:    call newtop		;set up the top of memory	pointer
        bcs 5$			;if ok
        return 
         
         
; - - -	y command	macro	command	processor
ycom:    
        IF r2	= #0		;<got an address?>
            mov zero,r2	;no address
            add #2,r2		;so default to line 1
        ELSE 
            IF r2 HI dol	;range check
10$:            mov #6,r1	;bad - error 6
                jmp error
            FI 
            IF r2 LOS	zero	;range check
                br 10$	;also	err 6
            FI 
        FI 
         
        mov (r2),r0		;get seek	address
        call getlin		;and line	into lbuf1 as asciz
         
        mov #-1,ipeek		;init it
        mov #lbuf1,iptr	;and this
         
        LOOP for r2 =	#1 TO #80.	;loop is for safety
            call igetc		;get	char from macro	line
            SELECT case R0 of
                 
            CASE #nl
                br err7		;bad, error	7
            CASE #0
                br err7		;bad, error	7
            CASE #'~  OR
            CASE #tab
                br gotit              ;~ or tab, same
            ESAC 
        NEXT r2
         
err7:   mov #16.,r1
        jmp error
         
gotit:   
        mov iptr,iadr			;save	beginning of string
        clr r1			;count chars in r1
10$:     
        call igetc
         
        IF r0	= #0
            br 20$
        ELSE 
            inc r1
            br 10$
        FI 
20$:     
        mov iadr,r0			;found a null
        dec r1
        call putbak
        return 
igetc:   
        IF ipeek = #-1
            movb @iptr,r0
            inc iptr			;get the char from the buffer and inc
            bic #177600,r0		;remove any funny	stuff
        ELSE 
            mov ipeek,r0		;else put 1	char back
            bic #177600,r0		;get rid of garbage
            mov #-1,ipeek		;clear putback char
        FI 
        IF r0 = #2                    ;to permit multi-command macros
            mov iptr,r0               ;change control b to nl
            movb #nl,-1(r0)
            mov #nl,r0
        FI 
         
        return 
; - - -	macrop	macro processor entry
         
;+
; This entry is	to allow putbak	macros to do some special
; stuff	that requires only a little code but cannot be done
; as a regular ued command. So we have a special command
; that is usually only put into	the input stream by a
; putbak call. The " command is	one of these. The macro	command
;	 ( not to be confused with the 'y' commmand)
; has data following the first byte which is a function code.
; It is dispatched here. Further data following the function code is
; optional and dependent upon the usage desired.
;-
         
macrop:  
         
        call getc		;get the function code
        SELECT case R0 of
             
        CASE #1		;the " command needs a special process
            call scom		;macro in progress suppresses a	search fail message
            clr macflg	;clear	macro in progress flag after the sub
            sub #2,dot	;go back a line
            return 
        CASE #2			;for the lcommand
            jmp lcom2	;second entry into l command
        DEFAULT 
            iot		;trouble
        ESAC 
;+
;
; Nonull - change input nulls to 177
;	input: lbuf2 is the ascii string
;	       r0 is the length
;	output:
;		lbuf2 is updated, regs restored
;-
nonull:  
        push r0
        push r1
        push r2
        mov #lbuf2,r1		;pointer to string at r0
        LOOP for r2 = #1 TO r0
            IFB (r1) = #0
                movb #177,(r1)		;make all nulls appear as 177
            FI 
            inc r1
        NEXT r2
        pop r2
        pop r1
        pop r0
        return 
         
         
;+
; ranges   check for character class ranges.
;	
;	If found ( x-y for any two ascii chars) then
;	do a put back of x+1 (next ascii char) thru y
;	if y is less than or equal to x, then a nop
;
;	The control-a (octal 1) char is a metachar that
;	will putback all invisible chars, incl 177
;
;	Input:
;		r0=current char, getc can access the next char
;	output:
;		r0 is untouched, but the putback buffer contains
;		additional stuff and the -y will have been eaten.
;-
ranges:  
        IF r0 = #control.a		;control a?
            call cchars
        ELSEIF r0 GE #40  AND  r0 NE #177 ;check if control putback
            push r0
            call getc			;check for range
            IF r0 = #'-
                call genrange
            ELSE 
                mov r0,peek			;retract 1
            FI 
            pop r0
        FI 
        return 
         
cchars:  
;
; set up for putback on control a
;
        push r0
        push r1
         
        mov #lowasc,r0			;addr
        mov #elow,r1			;len
        call putbak
         
        pop r1
        pop r0
         
        return 
         
         
genrange:  
         
         
;
; NOTE - a stack relative reference occurs below. It assumes a
;	 stack depth which could change if other code mods are
;	 done here. 
;
        push r0
        push r1
        push r2
        push r3
        mov 12(sp),r3	;get first char in range (this is the stack ref)
        inc r3		;but its still gonna be seen in r0
        call getc	;this will be the last char
        mov r0,r2
         
        LOOP for char = r3 TO r2	;let the Loop macro check the range for us
             
            mov #char,r0	;addr
            mov #1,r1	;len
            call putbak
            IF char = r2
                call putbak		;last one twice
            FI 
             
        NEXT char
         
        pop r3
        pop r2
        pop r1
        pop r0
        return 
        .end 
