$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 s1 s2 padr1 padr2 rts pc retag: call saval ;PRINTF #temp s1 s2 padr1 padr2 ;PRINTF #temp dot zero dol ;PRINTF #temp 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 r0 r1 clc rts pc FI NEXT r1 ; PRINTF #temp r0 sec rts pc .end