$MACRO putc jsr pc,putc $ENDM ; $MACRO getc IF r4 HIS last(r5) mov #-1,r0 ELSE movb (r4)+,r0 bic #177400,r0 FI $ENDM ; $MACRO putbac dec r4 $ENDM / PROGRAM sub setlab su ;- ; this module does all argument substitutions, handles all kinds of ; #@.. stuff. It is usually called only from expand although it ; sometimes is called directly (if you know what you're doing) ;+ ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - AUTO last out from to char AUTO r ends taddr nstrs sr4 ad function subs[toked,ntoks,mnum,output,saddr,parms] ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - ;- ; r4 is dedicated in this entire module - don't mess with it ; its used for the get char routines (getc/putbac) ; both getc and putbac are macros for speed, they generate ; code which fiddles with r4. ; all other registers are fair game, but they are used in ; various places allready. ;+ mov toked(r5),r0 ; this part is the init stuff add #2,r0 ; sets up input string location mov (r0),nstrs(r5) ; into r0 IF mnum LT #0 LET r0 = saddr + #12. ELSE LET r0 = mnum(r5) + mnum(r5) - #2 + #txpnt SUB parms(r5),ntoks(r5) MOV (R0),R0 FI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - mov r0,taddr(r5) ;this piece here was for the old movb (r0)+,r1 ;expander of macros. it returns bic #177400,r1 ;a value (function return) which clr r(r5) ;indicated if the line being expanded IF r1 GE #2 ;was a ?? special directive. Dumb stuff IFB (r0) = #'? ;but too much trouble to eliminate it MOVB #'?,R(R5) IFB 1(r0) = #'- OR 1(r0) = #'+ movb 1(r0),r(r5) IF r1 GE #3 movb 2(r0),r+1(r5) FI FI FI FI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - mov taddr(r5),r4 ;set up getc/putbac pointer r4 movb (r4)+,r0 ; and output pointer for putc add r4,r0 mov r0,last(r5) LET out(r5) = output(r5) + #13. mov output(r5),r0 add (r0),r0 mov r0,ends(r5) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - DO FOREVER ;main copy loop, copies getc ;char for char unless it finds BREAK IF LT ;and argument (#@ warning mode) IF r0 NE #'# ;in which case it calls aparm putc ;to do all the hard work ELSE getc IF r0 NE #'@ putbac mov #'#,r0 putc ELSE call aparm FI FI OD LET r1 = output(r5) + #12. ;this here stuff is to set up the count LET r0 = out(r5) - r1 - #1 ;field in the output correctly movb r0,(r1) RET R(R5) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - aparm: getc SELECT CASE r0 of ;getc puts a char into r0 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - CASE #'* ;#@*(f:t) call getp ;get a f,:,t into from,to,char call putargs ;and put the args out BREAK ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - CASE #'= ;#@=n(f:t) type call getn ;get the n mov r0,r3 ;save in r3 call getp ;get from,to,char call putseg ;put out a segment of an arg BREAK ;;; CASE #INREGS ;{ this is the old version here ;;; call getn ;;; mov r0,r3 ; ;;; call getadr ;;; LET sr4(r5) = ifnstr[@#..nsym,#..symbols,r0] ;;; mov #1,from(r5) ;;; mov #10000,to(r5) ;;; mov #':,char(r5) ;;; call putseg ;;; IF sr4(r5) NE #0 ;;;; mov #'(,r0 ;;;; putc ;;;; mov #'r,r0 ;;;; putc ;;;; mov #'5,r0 ;;;; putc ;;;; mov #'),r0 ;;;; putc ;;; LOOP for r3 = #inreg THRU #inreg+50. ;;; movb (r3),r0 ;;; BREAK IF EQ ;;; putc ;;; NEXT r3 ;;; FI ;;; getc ;;; BREAK CASE #INREGS ;{ #@{n} type call getn ; get the n mov r0,r3 call getadr ;get address of arg n mov r0,ad(r5) ;save it mov #1,from(r5) ;assume we copy all of arg mov #10000,to(r5) ; mov #':,char(r5) ; with null separator jsr pc,numchk ; but check to see if we got a number if cs ;cs means yes mov #'#,r0 ;so map arg to #arg. putc ; put # call putseg ; put arg mov ad(r5),r0 ; ifb 1(r0) ne #'0 ; if it is octal - arg begins with 0 mov #'.,r0 ; then we don't output the dot putc fi else ; we have a non-number LET sr4(r5) = ifnstr[@#..nsym,#..symbols,ad] call putseg ;output it all if sr4 ne 0 asl sr4 sr4 := sr4 + #..types - 2 ;index into type table mov @sr4(r5),sr4(r5) fi if sr4 = 1 or sr4 = 2 ;if auto or parm variable LOOP for r3 = #inreg THRU #inreg+50. movb (r3),r0 ;then we append the (r5) BREAK IF EQ ;to the end. This will soon be putc ;changed to check for types 1,2 NEXT r3 ;with the addition of reg FI ;and string types. FI getc BREAK ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - CASE #'# ;#@#n number variables call getn ; get n mov r0,r3 ; . .num$[r3] ; do all work here LET out = i2a[.num$[r3],out] BREAK ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - DEFAULT ;else its just a regular putbac ;argument, so put back the call getn ;x in #@x so we can get it again mov r0,r3 ;and set up to copy out whole segment mov #1,from(r5) mov #10000,to(r5) ;the 10000 means `to the end' mov #':,char(r5) call putseg ESAC rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - getn: getc ;get next hex digit -> r0 if r0 = #'v or r0 = #'V or r0 = #'@ call getn let r0 = .num$[r0] else IF r0 HI #'9 bis #40,r0 ;to lower CASE FI IF r0 HIS #'a IF r0 LOS #'y LET r0 = r0 - #127 ELSE mov #10000,r0 FI ELSE IF r0 HIS #'0 IF r0 LOS #'9 sub #60,r0 ELSE mov #10000,r0 ;out of range returns 10000 FI ELSE mov #10000,r0 FI FI fi rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - getp: ;get from, to, char tripple getc call getn mov r0,from(r5) getc mov r0,char(r5) call getn mov r0,to(r5) getc rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - getadr: ;get address of parm -> r0 PUSH r3 IF r3 LE nstrs(r5) mov toked(r5),r0 add #12.,r0 add parms(r5),r3 ble 30$ br 20$ 10$: movb (r0)+,r1 bic #177400,r1 add r1,r0 20$: sob r3,10$ 30$: ELSE clr r0 FI POP r3 rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - putseg: call getadr ;put segement ptseg1: ;here if we allready got the address IF r0 NE #0 movb (r0),r1 bic #177400,r1 beq 10$ IF r1 GE from(r5) IF r1 LT to(r5) mov r1,to(r5) FI add r0,to(r5) add r0,from(r5) mov from(r5),r1 DO FOREVER BREAK IF r1 HIS to(r5) movb (r1)+,r0 putc call putsep OD MOVB (R1)+,R0 putc FI 10$: FI rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - putc: ; put a single character ;check for overflow IF out(r5) LO ends(r5) movb r0,@out(r5) inc out(r5) FI rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - putsep: ;put a separator out SELECT CASE char(r5) of CASE #'_ mov #40,r0 BREAK CASE #': rts pc CASE #'" mov #greaterthan,r0 putc mov #lessthan,r0 BREAK DEFAULT MOV CHAR(R5),R0 BIC #177400,R0 ESAC putc rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - putarg: ;put out 1 or more args ;with separators IF ntoks(R5) LT from(R5) rts pc FI IF to(R5) GT ntoks(R5) mov ntoks(R5),to(R5) FI LOOP for r3 = from(R5) TO to(R5) call getadr movb (r0)+,r1 beq 20$ mov r0,r2 10$: movb (r2)+,r0 putc sob r1,10$ IF r3 NE to(r5) call putsep FI 20$: NEXT r3 rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - numchk: ;cc = not number, cs = is number push r0 push r2 movb (r0)+,r2 ble 20$ 5$: cmpb (r0),#'- beq 10$ cmpb (r0),#'0 blo 20$ cmpb (r0),#'9 bhi 20$ 10$: inc r0 sob r2,5$ sec br 25$ 20$: clc 25$: pop r0 pop r2 rts pc .end