home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 52 / af052sub.adf / false.lha / False / false.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-07-17  |  4.9 KB  |  101 lines
  1. /* Introducing: Portable False!!!!
  2.  
  3.    PortableFalse is different from AmigaFalse in:
  4.    - its Portable!!! :-)
  5.    - full stack checking
  6.    - strongly typed (no joke, really!)
  7.    - debug-modi
  8.    - real and meaningfull errormessages
  9.    - ` inline assembly not supported
  10.    - : and ; not supported for other than variable access.
  11.    - "beta" (flush) and "zero-slash" (pick) from the amiga charset
  12.      are now 'B' and 'O' resp.
  13.    - 'D' toggles stack-watch mode on and off. format:
  14.      [ bottom_of_stack , ... , top_of_stack | next_symbol ]
  15.    - "-q" on command line is quiet mode: no title printing.
  16.      (usefull for "filter"-type programs: 1> False -q filter.f <bla >burp)
  17.  
  18.    this source has been writtin in good C style:
  19.    - no modularity whatsoever (only main())
  20.    - only global variables
  21.    - lots of ugly macros (replacing functions)
  22.    - great source formatting and indentation
  23.  
  24.    still it compiles on 4-5 different ansi-C compilers. if you have trouble
  25.    porting it to your machine, your compiler sucks. (guaranteed to be
  26.    digested by: MaxonC++, SAS/C, DICE, GNUC++ (also on other platforms))
  27.  
  28.    todo:
  29.    - interactive debugging?
  30.  
  31.    False, Amiga False, Portable False are all trademarks of $#%!
  32.  
  33. */
  34.  
  35. #define MZ 10000
  36. #define MS 1000
  37. #include <stdio.h>
  38. #define NIL 0
  39. #define NUM 0
  40. #define FUNC 1
  41. #define VADR 2
  42. #define UNDEF 3
  43. #define l(x) ;break;case x:
  44. #define x(num) {ernum=num;goto er;}
  45. #define push(v,a) {if(S-2<sbeg)x(4)else{*--S=(v);*--S=(X)a;};}
  46. #define pop(v,a) {if(S+2>se)x(5)else{if((ex=(int)a)!=(ge=(int)*S++))x(6);\
  47. v= *S++;};}
  48. #define pa(v,av) {if(S+2>se)x(5)else{av= *S++;v= *S++;};}
  49. #define ru(v) {if(rp-1<rbeg)x(13)else{*--rp=(v);};}
  50. #define ro(v) {if(rp+1>rend)x(14)else{v= *rp++;};}
  51. #define CA(c) {ru(p);p=c;}
  52. #define pu(x) push(x,NUM)
  53. #define po(x) pop(x,NUM)
  54. #define op(o) {po(b)po(d);pu((X)((int)d o (int)b));}
  55. #define cm(o) {po(b)po(d);pu((X)(-((int)d o (int)b)));}
  56. #define un(o) {po(b)pu((X)(o (int)b));}
  57. #define ne (p<end)
  58. #define W while
  59. #define ec {W((*p!='}')&&ne)p++;p++;if(!ne)x(10);}
  60. #define P printf
  61. typedef char*X;typedef char**XP;X ST[MS],RST[MS],var[52],b,d,e,f,t1,t2,t3;
  62. XP sbeg=ST+12,se=ST+MS-12,S,ts,rbeg=RST+12,rend=RST+MS-12,rp,vp;int ernum=
  63. 0,t,db=0,ex,ge,qq;FILE*fh;char src[MZ+5],a,c=0,*s,*end,*beg,*p=0,*erstr[]=
  64. {"no args","could not open source file","source too large","data stack ov"
  65. "erflow","data stack underflow","type conflict","stack not empty at exit "
  66. "of program","unknown symbol","portable inline assembly not available","u"
  67. "nbalanced '{'","unbalanced '\"'","unbalanced '['","return stack overflow"
  68. ,"return stack underflow"},*types[]={"Integer","Functional","Variabele",""
  69. "Unitialised"};int main(int narg,char*args[]){S=se;rp=rend;t=1;for(vp=var;
  70. vp<(var+52);){*vp++=(X)UNDEF;};if(narg>1)if(args[1][0]=='-'&&args[1][1]==
  71. 'q')t=2;if(t==1)P("Portable False Interpreter/Debugger v0.1 (c) 1993 $#%!"
  72. "\n");if(narg<t+1)x(1);if((fh=fopen(args[t],"r"))==NIL)x(2);s=src;*s++=
  73. '\n';W((a=fgetc(fh))!=EOF)if((src+MZ)<=s){fclose(fh);x(3)}else{*s++=a;};*s
  74. ++='\n';fclose(fh);end=s-1;beg=src+1;p=beg;W(ne){c= *p++;if(c>='0'&&c<='9'
  75. ){int num;sscanf(p-1,"%d",&num);W((*p>='0')&&(*p<='9'))p++;push((X)num,NUM
  76. );}else if(c>='a'&&c<='z'){push((X)&var[(c-'a')*2],VADR);}else switch(c){
  77. case' ':case '\n':case'\t':l('+')op(+)l('-')op(-)l('*')op(*)l('/')op(/)l(
  78. '&')op(&)l('|')op(|)l('_')un(-)l('~')un(~)l('=')cm(==)l('>')cm(>)l('%')pa(
  79. b,e)l('$')pa(b,e)push(b,e)push(b,e)l('\\')pa(b,e)pa(d,f)push(b,e)push(d,f)
  80. l('@')pa(b,t1)pa(d,t2)pa(e,t3)push(d,t2)push(b,t1)push(e,t3)l('O')po(b)if(
  81. S+((t=(int)b*2)+2)>se)x(5)b= *(S+t);d= *(S+t+1);push(d,b)l(':')pop(b,VADR)
  82. pa(d,e)*((XP)b)=d;*(((XP)b)+1)=e;l(';')pop(b,VADR)push(*((XP)b),*(((XP)b)+
  83. 1));l('.')po(b)P("%d",(int)b);l(',')po(b)P("%c",(char)b);l('^')pu((X)fgetc
  84. (stdin));l('B')fflush(stdout);fflush(stdin);l('\"')W((*p!='\"')&&ne){fputc
  85. (*p,stdout);p++;};p++;if(!ne)x(11);l('{')ec;l('\'')pu((X)*p++);l('`')x(9);
  86. l('D')db=!db;l('[')push((X)p,FUNC)t=1;W(t>0&&ne){a= *p++;if(a=='['){t++;}
  87. else if(a==']'){t--;}else if(a=='{'){ec}else if(a=='\"'){W((*p!='\"')&&ne)
  88. p++;p++;if(!ne)x(11);};};if(!ne)x(12);l(']')ro(e)if((int)e==0){ro(p)po(b)
  89. if((int)b){ro(d)ru(d)CA(d)ru((X)1);}else{ro(d)ro(d);};}else if((int)e==1){
  90. ro(p)ro(b)ro(d)ru(d)ru(b)CA(d)ru((X)0);}else{p=e;};l('!')pop(b,FUNC)CA(b);
  91. l('?')pop(b,FUNC)po(d)if((int)d){CA(b);};l('#')pop(b,FUNC)pop(d,FUNC)ru(d)
  92. ru(b);CA(d)ru((X)0);break;default:x(8);};if(db){c= *p;if(c!=' '&&c!='\n'&&
  93. c!='\t'&&c!='{'&&c!='\"'){ts=S+20;if(ts>se)ts=se;P("[");W(ts>S){t=(int)*(
  94. ts-2);if(t==FUNC){P("<func>");}else if(t==VADR){P("<var>");}else P("%d",(
  95. int)*(ts-1));ts-=2;if(ts>S)P(",");};P("|'%c']\n",*p);}};};c=0;p=0;if(S!=se
  96. )x(7);er:if(ernum){P("\nERROR: %s!\n",erstr[ernum-1]);if(c)P("WORD:  '%c'"
  97. "\n",c);if(ernum==6)P("INFO:  Expecting %s type, while reading %s type.\n"
  98. ,types[ex],types[ge]);if(p){end=p;beg=p;W(*(beg-1)!='\n'){beg--;};W(*end!=
  99. '\n'){end++;};t=end-beg;*end=0;if(t>0){P("LINE:  %s\n",beg);qq=p-beg+3;P(
  100. "AT:");for(t=0;t<qq;t++){putchar(' ');};P("^\n");};};}return 0;}
  101.