; 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 ; 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