0 GOTO1000 : REM M100FALSE started FEB 27,2013 Chris McCallum vyv@sympatico.ca 1 S(S-1)=S(S-1)+S(S):S=S-1:NEXT 'add 2 S(S-1)=S(S-1)-S(S):S=S-1:NEXT 'sub 3 S(S-1)=S(S-1)*S(S):S=S-1:NEXT 'mult 4 S(S-1)=S(S-1)/S(S):S=S-1:NEXT 'div 5 S=S+1:S(S)=S(S-1):NEXT 'dup 6 S=S-1:NEXT 'drop 7 T=S(S):S(S)=S(S-1):S(S-1)=T:NEXT 'swap 8 T=S(S):S(S)=S(S-2):S(S-2)=S(S-1):S(S-1)=T:NEXT 'rot 9 S(S)=S(S-(S(S)):NEXT 'pick 10 S(S)=-(S(S)):NEXT 'neg 11 S(S-1)=(S(S)=S(S-1)):S=S-1:NEXT 'eql 12 S(S-1)=(S(S-1)>S(S)):S=S-1:NEXT 'gt 13 S(S-1)=(S(S)ANDS(S-1)):S=S-1:NEXT 'and 14 S(S-1)=(S(S)ORS(S-1)):S=S-1:NEXT 'or 15 S(S)=NOTS(S):NEXT 'not 16 T=S(S):C=VARPTR(S(S-1)):POKET,PEEK(C):POKET+1,PEEK(C+1):S=S-2:NEXT 'assign 17 T=PEEK(S(S)):C=PEEK(S(S)+1):POKEVARPTR(S(S)),T:POKEVARPTR(S(S))+1,C:NEXT 'deref 18 GOTO40 'slambda 19 GOTO50 'elambda 20 R=R+1:R(R)=P:P=S(S):S=S-1:NEXT 'apply 21 S=S-2:IFS(S+1)THENR=R+1:R(R)=P:P=S(S+2):NEXTELSENEXT 'if 22 R=R+3:R(R-2)=P:R(R-1)=S(S-1):R(R)=S(S):P=S(S-1):S=S-2:NEXT 'while 23 P=P+1:S=S+1:S(S)=ASC(P$(P)):NEXT 'push char 24 S=S+1:S(S)=ASC(INPUT$(1)):NEXT 'get char 25 PRINTS(S);:S=S-1:NEXT 'pnum 26 PRINTCHR$(S(S));:S=S-1:NEXT 'pchar 27 FORT=0TO1:P=P+1:IFP$(P)=CHR$(34)THENT=1:NEXT:NEXT ELSEPRINTP$(P);:T=0:NEXT 'pline - I can't believe this works!! 28 FORT=0TO1:P=P+1:IFP$(P)="}"THENT=1:NEXT:NEXT ELSET=0:NEXT 'comment 29 PRINT:PRINTTIME$:END 'end of source file 39 REM-------------------slambda helper 40 S=S+1:S(S)=P:C=1 41 FORT=0TO1 42 P=P+1:IFP$(P)="["THENC=C+1ELSEIFP$(P)="]"THENC=C-1 43 IFC>0THENT=0ELSET=1 44 NEXT:NEXT 49 REM-------------------elambda helper 50 IFP$(R(R-2))="#"THENIFS(S)THENR(R+1)=R(R-1):R(R+2)=R(R):R=R+2:S=S-1 ELSE R=R-2:S=S-1 51 P=R(R):R=R-1:NEXT 59 REM-------------------handle numbers 60 S=S+1:S(S)=0 61 FORT=0TO1 62 S(S)=10*S(S)+VAL(P$(P)) 63 P=P+1 64 IFP$(P)=>"0"ANDP$(P)<="9"THENT=0ELSET=1 65 NEXT 66 P=P-1 67 NEXT 69 REM-------------------handle variables 70 S=S+1:S(S)=VARPTR(V((ASC(P$(P))-ASC("a")))):NEXT 99 REM-------------------interpret 100 TIME$="00:00:00":FORI=0TO1:I=0:P=P+1:J=INSTR(C$,P$(P)) 101 ONJGOTO1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29 102 IFP$(P)=>"0"ANDP$(P)<="9"THENGOTO60 103 IFP$(P)=>"a"ANDP$(P)<="z"THENGOTO70 104 NEXT 'silently ignore other chars 999 REM-----------------main 1000 GOSUB12000 'init 1010 GOSUB11000 'banner 1020 GOSUB10000 'load file 1030 IFP$<>""THENGOSUB100 'interpret file 1998 END 9999 REM----------------load file 10000 INPUT"File to load";P$ 10010 IFP$=""THENRETURN 10020 OPENP$FORINPUTAS1:J=0 10030 FORI=0TO1 10040 P$(J)=INPUT$(1,1):J=J+1:PRINT"."; 10050 IFNOTEOF(1)THENI=0 10060 NEXT 10065 P$(J)=CHR$(0) 'end with null 10070 CLOSE:PRINT:RETURN 10999 REM----------------banner 11000 CLS 11010 PRINT"M100 False v1" : PRINT 11020 RETURN 11999 REM----------------init 12000 ONERRORGOTO60000 12002 DEFINTA-Z 12006 DIMS(128) : S=-1 12008 DIMR(128) : R=2 'avoid underflow in elambda helper 12010 DIMP$(1024) : P=-1 12012 DIMV(26) 12013 C$="+-*/$%\@P_=>&|~:;[]!?#'^.,"+CHR$(34)+"{"+CHR$(0) 12014 I=0:J=0 'temp vars 12015 T=0:C=0 'these temp vars exclusive to jumptable 12016 P$="" 'false file name 12098 RETURN 59999 REM----------------error 60000 PRINT:T=0 60010 IFERR=9ANDS>128THENPRINT"Stack Overflow";:T=1 60020 IFERR=5ANDERL<100THENPRINT"Stack Underflow";:T=1 60030 IFERR=9ANDP>1024THENPRINT"PC out of bounds";:T=1 60040 IFERR=11ANDERL=4THENPRINT"Divide by Zero";:T=1 60050 IFERR=52ANDERL=10020THENPRINT"No such file";:END 60060 IFERR=6ANDERL<100THENPRINT"Number too big";:T=1 60070 IFT=0THENPRINT"**ERR";ERR;"line:";ERL:LIST.:END 60080 PRINT" S";S;" R";R-3;" P";P:PRINT"Stack:"; 60090 FORT=S-10TOS 60100 IFT>-1ANDT<129THENPRINTS(T); 60110 NEXT:PRINT 60120 FORT=P-19TOP+19 60130 IFT>-1THENPRINTP$(T); 60140 NEXT:PRINT 60150 FORT=P-19TOP-1 60160 IFT>-1THENPRINT" "; 60170 NEXT:PRINT"^" 60180 END