$MACRO ALL VAR JSR PC,$$RES RES.STR #@{1} @#$$RES1 $ENDM ; - - - - - - - - - - - - - - - - - - - - - - - $MACRO FRE MOV (SP),R0 ADD R0,SP $ENDM ; - - - - - - - - - - - - - - - - - - - - - - - $MACRO RES.STR ; NAME,SIZE SUB #@2,SP SUB #10.,SP MOV #1,-(SP) MOV #@2,-(SP) ADD #8.,(SP) MOV SP,#@1 MOV #@1,-(SP) JSR PC,INI ADD #6.,(SP) JSR PC,$$$STK $ENDM ; - - - - - - - - - - - - - - - - - - - - - - - $MACRO print ** p%%t <#@*(1"Z)> $ENDM ; - - - - - - - - - - - - - - - - - - - - - - - $MACRO p%%t printf "#@1=(%d)(%o)" <#@1> <#@1> $ENDM ; - - - - - - - - - - - - - - - - - - - - - - - $MACRO LEN string ?? 2 mov #@{1},r0 #@2=. tstb (r0)+ bne #@2 sub #@{1},r0 dec r0 $ENDM / program stat gotable: .word justout ;output 0 .word $let ;let 1 .word disp2 ; -- 2 .word disp2 ; -- 3 .word $rept ; ** 4 .word disp2 ; -- 5 .word disp2 ; -- 6 .word $mov ; 7 .word disp2 ; -- 8 .word disp2 ; -- 9 .word $stkops ; ? stuff 10 .word $stkops ; ? stuff 11 .word $stkops ; ? stuff 12 .word $stkops ; ? stuff 13 .word $stkops ; ? stuff 14 .word $csym ; -- 15 .word $.macro ; macros 16 .word notyet ; 17 .word notyet ; 18 .word notyet ; 19 .word notyet ; 20 .word notyet ; 21 .word notyet ; 22 .word notyet ; 23 .word $din ; 24 .word $dout ;d%out 25 .word $ifin ;i%in 26 .word $err ;i%err 27 .word $slen ; 28 .word $es ;e%s 29 .word $typecode ;t%yp 30 .word $ifblank ;i%b 31 .word $ifnonblank ;i%nb 32 .word $ifidn ;i%idn 33 .word $ifdif ;i%df 34 .word $ifsw ;i%sw 35 .word $ssw ;s%sw 36 .word $dsym ;d%sym 37 etable=<.-gotable/2>-1 statement:: push r0 push r1 push @2(r5) call newstat tst (sp)+ pop r1 pop r0 rts pc auto l,n,t,s,code,num[4],parms[10.] auto t1,t2,t3,t4,np,ll,labout function newstat[smp] inc slevel ;recursiveness of this routine ifb opini = #0 inc opini call tabset fi all t if slevel le 0 and dbuger ne 0 dbug[&s] fi clr l(r5) . instr[t,#22.] let s = smp let n = toksl[s,t] if n gt #50. let n = n - #100. let l = l + #1 fi let code = stat1[fndstr[t,]] if md.switch ne #0 all r4 . strng[r4,"; "] . append[r4,smp,#1] . outst[r4] fre fi clr labout(r5) if code ne #0 and l ne #0 inc labout(r5) . outst[t] fi if code le #etable begin let r2 = .gotable[code] neg l(r5) jmp (r2) ; - - - - - - - - - - - - - - - - - - - - - $let: . lett[s,t,n,l] jmp fin $rept: all r4 loop for r3 = #3 to n let r2 = fndstr[t,r3] ifb (r2) ne #0 . mvstr[r4,t,#2] . append[r4," ",#0] . append[r4,t,r3] . state[r4] fi next r3 jmp fin $mov: if slevel le 0 jmp justout ;if level 0, then don't check mov, do a just out fi let ll = l * -1 all r4 ;. exstat["xx #@1,#@2,#@3",&s,0] . strng[r4,"-2.(r5)"] if .swval[#19.-1] ne 0 loop for r2 = 0 to 1 let r3 = cmpstr[r4,1,t,] if r3 = 0 . copy[t,,#$stack,60] break fi next r2 fi ;. exstat["xx1 #@1,#@2,#@3",&s,0] . strng[r4,"#0"] if cmpstr[r4,1,t,] = 0 . expand[" clr #@2",r4,&s] else . expand[" mov #@1,#@2",r4,&s] fi . outst[r4] jmp fin $stkops: . stkops[,s,t,n,l] jmp fin $csym: clr ..nsym ;clear number of symbols jmp fin $.macro: mov #1,parms(r5) let parms+2(r5) = &s push r5 let r5 = r5 + #parms jsr pc,macros pop r5 jmp fin $din: all r4 push slevel push dbuger let slevel := -1 let dbuger := 0 . mvstr[r4,t,#2] . state[r4] pop dbuger pop slevel jmp fin $dout: all r4 let r2 = fndstr[t,#2] . mvstr[r4,t,#2] ifb (r2) ne #0 . outst[r4] fi jmp fin $ifin: all t1 all t2 all t3 . mvstr[t2,t,#3] ; get parm 3 in t2 . instr[t3,#20.] ;make it a 20 element string let np = toks[t2,t3] ;t3 gets token'd string let r3 = ifnstr[np,t3,fndstr[t,#2]] ;find loc of parm2 in parm3 if r3 le #0 ;not there fre fre fre mov #5,r3 call outstt else . mvstr[t2,t,#4] . instr[t3,#20.] let np = toks[t2,t3] let r0 = fndstr[t3,r3] ifb (r0) ne #0 . mvstr[t1,t3,r3] fre fre . state[t1] fi fi jmp fin $err: all r4 ; . strng[r4,".error ;"] ; . append[r4,t,#2] ; . outst[r4] push num$+100. mov num$+100.,num$+18. expand[".error #@#9. ; #@1",r4,&s] outst[r4] expand["line #@#9 #@1",r4,&s] . echo[r4,#1] pop num$+100. jmp fin $slen: let r4 = valx[fndstr[t,#3],#10.] if r4 ge #0 and r4 le #50. let r3 = fndstr[t,#2] movb (r3),r3 leta .num$[r4] = r3 fi jmp fin $es: let r4 = ifnstr[..nsym,#..symbols,fndstr[t,#2]] if r4 = #0 mov ..nsym,r4 inc ..nsym . copy[#..symbols,..nsym,t,#2] else dec r4 fi leta ...types[r4] = valx[fndstr[t,#3],#10.] jmp fin $typecode: let r4 = ifnstr[..nsym,#..symbols,fndstr[t,#2]] if r4 = #0 clr r2 else let r2 = ...types[] fi let r3 = valx[fndstr[t,#3],#10.] if r3 ge #0 and r3 lt #50. leta .num$[r3] = r2 else . exstate["i%err ",&s,#0] fi jmp fin $ifblank: call tstblk mov #4,r3 if r0 = #0 dec r3 fi call outstt jmp fin $ifnonblank: call tstblk mov #3,r3 if r0 = #0 inc r3 fi call outstt jmp fin $ifidn: call cmpstt mov #4,r3 if r0 = #0 inc r3 fi call outstt jmp fin $ifdif: call cmpstt mov #5,r3 if r0 = #0 dec r3 fi call outstt jmp fin $ifsw: call valp2 mov #4,r3 if r4 gt #0 and r4 le #nsw if .swval[] ne #0 dec r3 fi call outstt fi jmp fin $ssw: call valp2 mov #-1,r2 if r4 lt #0 neg r4 clr r2 fi if r4 gt #0 and r4 le #nsw leta .swval[] = r2 fi jmp fin $dsym: push r5 jsr pc,dmpsym pop r5 jmp fin notyet: justout: if n gt #0 let r0 = fndstr[smp,#1] ifb (r0) ne #0 if slevel le 0 and na.switch = 0 . assign[s,t,n,l,labout] else . outst[smp] fi fi fi jmp fin ; - - - - - - - - - - - - - - - - - - - - - disp2: . hards[code,s,t,n,] jmp fin ; - - - - - - - - - - - - - - - - - - - - - end else . macexp[code,s,t,n,] jmp fin fi fin: dec slevel ret valp2: ;r4 gets value of parameter 2 let r4 = valx[fndstr[t,#2],#10.] rts pc locate: ;Return r4=ptr to arg 1 let r4 = fndstr[t,#2] rts pc tstblk: ;if arg 1 is blank r0=0 else r0=1 call locate clr r0 ifb (r4) ne #0 inc r0 fi rts pc outstt: ;outputs t(r3) let r0 = fndstr[t,r3] ifb (r0) ne #0 all r2 . mvstr[r2,t,r3] . state[r2] fre fi rts pc cmpstt: ;cmp t(2) to t(3) equal r0=1 else r0=0 let r0 = cmpstr[t,#2,t,#3] inc r0 rts pc function echo[smp,nn] let r4 = fndstr[smp,nn] movb (r4)+,r3 mov r3,r2 add r4,r2 movb (r2),r1 clrb (r2) mov r4,-(sp) jsr pc,$type$ movb r1,(r2) ret .end