// SwatExp.bcpl - expression evaluator // Copyright Xerox Corporation 1979, 1982 // Last modified March 21, 1982 1:39 PM by Boggs // All you do is just...08/04/73 (alb) get "Swat.decl" external [ // outgoing procedures InitExp; Exp // incoming procedures SymToAddr; VMFetch; ReportFail StoreVec; Allocate // outgoing statics ARGS; NARGS; ALTFLG; ALTFLG2 // incoming statics sysZone openCell; openFrame ] static [ ARGS; NARGS; ALTFLG; ALTFLG2 LkupStr // holds raw Characters read Char // holds current Character Lchar Charno Ostk; Astk; StrBuf; ComBuf TkNxtChFlg; NoDigFlg; SymRdFlg; OctRdFlg ] structure Stack: [ ub word ptr word entry^1,1 word ] structure SStack: //String Stack [ ub word //note that ptr plus entry is a BCPL string! ptr byte entry^1,1 byte ] structure [ LH byte; RH byte 1 ] //--------------------------------------------------------------------------- let InitExp() be //--------------------------------------------------------------------------- [ ARGS = Allocate(sysZone, 17) LkupStr = Allocate(sysZone, 64); LkupStr>>SStack.ub = 125 StrBuf = Allocate(sysZone, 64); StrBuf>>SStack.ub = 125 Ostk = Allocate(sysZone, 64); Ostk>>Stack.ub = 62 Astk = Allocate(sysZone, 64); Astk>>Stack.ub = 62 ] //--------------------------------------------------------------------------- and StkRst(stknm) be stknm>>Stack.ptr = 0 //--------------------------------------------------------------------------- //--------------------------------------------------------------------------- and Push(value, stknm) be //--------------------------------------------------------------------------- [ let t = stknm>>Stack.ptr if t eq stknm>>Stack.ub do ReportFail("Exp stack overflow") t = t +1 stknm>>Stack.entry^t = value stknm>>Stack.ptr = t ] //--------------------------------------------------------------------------- and Pop(addr, stknm) = valof //--------------------------------------------------------------------------- [ let t = stknm>>Stack.ptr if t eq 0 resultis false @addr = stknm>>Stack.entry^t stknm>>Stack.ptr = t-1 resultis true ] //---------------------------------------------------------------------------- and SStkRst(sstknm) be sstknm>>SStack.ptr = 0 //---------------------------------------------------------------------------- //---------------------------------------------------------------------------- and SPush(char, sstknm) be //---------------------------------------------------------------------------- [ let t = sstknm>>SStack.ptr if t eq sstknm>>SStack.ub then ReportFail("String stack overflow") t = t +1 sstknm>>SStack.entry^t = char sstknm>>SStack.ptr = t ] //---------------------------------------------------------------------------- and SPop(addr, sstknm) = valof //---------------------------------------------------------------------------- [ let t = sstknm>>SStack.ptr if t eq 0 resultis false @addr = sstknm>>SStack.entry^t sstknm>>SStack.ptr = t-1 resultis true ] //--------------------------------------------------------------------------- and GetCh() be //--------------------------------------------------------------------------- [ Charno = Charno +1 Lchar = Char Char = ComBuf!Charno ] //--------------------------------------------------------------------------- and GetVal(s) = valof //--------------------------------------------------------------------------- [ if @s eq @"." resultis openCell if @s eq @"$" resultis openFrame if NoDigFlg eq 0 then //convert string to octal num [ let val = 0 for i = 1 to s>>String.length do val = (val lshift 3) + (s>>String.char^i-$0) resultis val ] if NoDigFlg eq 1 & Lchar eq $. then //convert string to decimal num [ @s = @s-400b //remove $. let val = 0 for i = 1 to s>>String.length do val = val*10 + (s>>String.char^i-$0) resultis val ] resultis SymToAddr(s) ] //--------------------------------------------------------------------------- and Op(char) = selecton char into //--------------------------------------------------------------------------- [ case $!: true; case $": true; case $#: true; case $%: true case $&: true; case $': true; case $(: true; case $**: true case $+: true; case $-: true; case $@: true; case $\: true case $*140: true; case $|: true; case $~: true default: false ] //--------------------------------------------------------------------------- and UnOp(char) = selecton char into //--------------------------------------------------------------------------- [ case $": true; case $#: true; case $(: true; case $+: true case $-: true; case $@: true; case $~: true default: false ] //--------------------------------------------------------------------------- and Prec(char, unopflg) = selecton char into //--------------------------------------------------------------------------- [ case $!: #167; case $": #177; case $#: #177; case $%: #127 case $&: #133; case $': #123; case $(: #177; case $**: #157 case $+: unopflg? #163, #153 case $-: unopflg? #163, #153 case $@: #163; case $\: #157; case $*140: #123 case $|: #157; case $~: #137 default: #377 ] //--------------------------------------------------------------------------- and Apply(fun) be //--------------------------------------------------------------------------- [ let t1, t2 = nil, nil Pop(lv t1, Astk) Push(selecton fun & 377B into [ case $!: VMFetch(t1 & Pop(lv t2, Astk) + t2) case $%: (t1 & Pop(lv t2,Astk)) % t2 case $&: (t1 & Pop(lv t2,Astk)) & t2 case $': (t1 & Pop(lv t2,Astk)) xor t2 case $**: (t1 & Pop(lv t2,Astk))*t2 case $+: valof [ if (fun & 177400B) eq (163B lshift 8) resultis t1 Pop(lv t2, Astk) resultis t1 + t2 ] case $-: valof [ if (fun & 177400B) eq (163B lshift 8) resultis -t1 Pop(lv t2, Astk) resultis t2 - t1 ] case $/: valof [ Pop(lv t2, Astk); resultis t2/t1 ] case $@: VMFetch(t1) case $\: valof [ Pop(lv t2, Astk); resultis t2 rem t1 ] case $*140: (t1 & Pop(lv t2, Astk)) eqv t2 case $|: valof [ Pop(lv t2, Astk) resultis t1 ls 0? t2 rshift -t1, t2 lshift t1 ] case $~: not t1 default: t1 ], Astk) ] //--------------------------------------------------------------------------- and Exp(n) = valof //--------------------------------------------------------------------------- [ ComBuf = n // set up for GetCh let t = 0 Exp3: //reset flags, variables, stacks Char = -1 Charno = 0 NARGS = 0 TkNxtChFlg = false NoDigFlg = false ALTFLG = false ALTFLG2 = false SymRdFlg = false OctRdFlg = false StkRst(Ostk) StkRst(Astk) SStkRst(StrBuf) SStkRst(LkupStr) ARGS!0 = 0 Exp4: //main reading loop GetCh() if TkNxtChFlg then [ TkNxtChFlg = false; goto Exp5 ] //ctl-Char? if Char ge 40b & Char ne $? then [ //no ALTFLG = false if ALTFLG2 do [ NARGS, ALTFLG2 = NARGS+1, false ] //2 alt's goto Exp6 ] unless SymRdFlg goto Exp1 //yes SymRdFlg = false Push(GetVal(LkupStr+1), Astk) SStkRst(LkupStr) //reset string-stack for next time NoDigFlg = false while Pop(lv t, Ostk) & ((t & 377B) ne $() do Apply(t) unless (Ostk>>Stack.ptr eq 0) & (Astk>>Stack.ptr eq 1) goto Experr NARGS = NARGS+1; Pop(lv (ARGS!NARGS), Astk) ARGS!0 = ARGS!0 % (1 lshift NARGS) //alt-mode? if Char eq $*033 then [ //yes if ALTFLG do [ ALTFLG = true; goto Exp4 ] //2nd alt? ALTFLG = true goto Exp4 ] resultis Char Exp5: unless SymRdFlg do SymRdFlg = true SPush(Char, LkupStr) goto Exp4 Exp6: if Char eq $. % Char eq $$ % Char eq $^ % (Char le $9 & Char ge $0) % (Char le $z & Char ge $a) % (Char le $Z & Char ge $A) then [ if Char le $9 & Char ge $0 then [ //dec-dig? if OctRdFlg then [ if Char ls $8 goto Exp5 //oct-dig goto Experr ] goto Exp5 ] if OctRdFlg goto Experr NoDigFlg = NoDigFlg +1 goto Exp5 ] if OctRdFlg & (LkupStr>>SStack.ptr eq 0) goto Experr SymRdFlg = false if (Lchar eq -1) % Op(Lchar) % (Lchar eq $*033) then [ unless UnOp(Char) & not Lchar eq $# goto Experr if Char eq $" goto Exp7 if Char eq $# then [ OctRdFlg = true; goto Exp4 ] Push(Char+Prec(Char, true) lshift 8, Ostk) goto Exp4 ] if Lchar eq $) then [ if (Char ne $+) & (Char ne $-) & UnOp(Char) goto Experr goto Exp2 ] Push(GetVal(LkupStr+1), Astk) OctRdFlg, NoDigFlg = false, false SStkRst(LkupStr) //reset string-stack for next time Exp2: if Char eq $) then [ Exp98: Pop(lv t, Ostk); if (t & 377B) eq $( goto Exp4 Apply(t) goto Exp98 ] Exp99: //If the op-stack is empty, or if the top of the op-stack is ")", // or if the current character has greater operator precedence than //the top of the op-stack, then we apply the current character // as an operator; otherwise we apply the top of the op-stack. if (Ostk>>Stack.ptr eq 0) % ((lv (Ostk>>Stack.entry^(Ostk>>Stack.ptr)))>>RH eq $() % (Prec(Char, false) gr (lv (Ostk>>Stack.entry^(Ostk>>Stack.ptr)))>>LH) then [ Push(Char+Prec(Char, false) lshift 8, Ostk) goto Exp4 ] Pop(lv t, Ostk); Apply(t) goto Exp99 Exp7: GetCh() if Char eq $** then [ GetCh() switchon Char into [ case $": endcase case $**: endcase case $n: [ SPush($*N, StrBuf); Char = $*L; endcase ] case $s: [ Char = $*S; endcase ] case $t: [ Char = $*T; endcase ] default: goto Experr ] SPush(Char, StrBuf) ] unless Char eq $" do [ SPush(Char, StrBuf); goto Exp7 ] t = (StrBuf>>SStack.ptr)/2+1 Push(StoreVec(StrBuf+1, t), Astk) SStkRst(StrBuf) goto Exp4 Exp1: if Op(Lchar) & (Lchar ne $") goto Experr while Pop(lv t, Ostk) do [ if (t & 377B) eq $( goto Experr; Apply(t) ] unless Astk>>Stack.ptr ls 2 goto Experr NARGS = NARGS +1 unless Char eq $*033 do //Esc [ unless Astk>>Stack.ptr eq 0 do [ ARGS!0 = ARGS!0 % (1 lshift NARGS) Pop(lv (ARGS!NARGS), Astk) ] if ALTFLG do NARGS = NARGS -1 if ALTFLG2 do NARGS = NARGS -1 if (ARGS!0 & (1 lshift NARGS)) eq 0 do NARGS = NARGS -1 resultis Char ] if ALTFLG do [ ALTFLG2 = true; goto Exp4 ] ALTFLG = true unless Astk>>Stack.ptr eq 0 do [ ARGS!0 = ARGS!0 % (1 lshift NARGS) Pop(lv (ARGS!NARGS), Astk) ] goto Exp4 Experr: ReportFail("Bad expression") ]