/*
   pbrain interpreter in old-style C
   This is an interpreter for Paul M. Parks's pbrain programming language,
       a variant of Urban Mueller's programming language.
   Do anything you want with this program.
   I welcome bug reports and feature requests.
   Daniel B Cristofani (http://www.hevanet.com/cristofd/)

   20130327, extended and put into service as cbrain
   20210410, core parts moved to CMS VM/370 CE

   cbrain

   btiffin (https://sourceforge.net/users/btiffin)
   Tectonics: global txtlib gccres
              gcc cbrain (cms
              load cbrain (clear origin A0000
              genmod cbrain
              cbrain prog
*/

#include <ctype.h>
#include <string.h>
#include <stdio.h>
#include <limits.h>
#include <stdlib.h>
#include <time.h>

#define VERSION 0.7

#define SIZE 8192
#define PROCEDURES 256
#define NUMBITS sizeof(long)*8
#define CA(x) case x: fprintf(stderr, "Error: "

long a[SIZE], memreg;
int s[SIZE], sp, ptable[PROCEDURES], t[SIZE], p, q, r, length;
int c, tmp, quit, scale, tracer, tracing;
char code[SIZE], *f, bin[NUMBITS+1];
FILE *input;

const char *long_to_binary(unsigned long x) {
    unsigned long i=1UL << NUMBITS-1;
    char *d=bin;
    *d++=(i & x)?'1':'0';
    while (i>>=1) *d++=(i & x)?'1':'0';
    *d++='\0';
    return bin;
}

int e(int i){
    switch(i){
        CA(2) "call to undefined procedure (%hu) with %d at %d of %s", a[p], p, q, f); break;
        CA(3) "pointer too far %s at %d of %s", p>0?"right":"left", q, f); break;
        CA(4) "unmatched '[' at byte %d of %s", s[sp], f); break;
        CA(5) "unmatched ']' at byte %d of %s", q, f); break;
        CA(6) "unmatched '(' at byte %d of %s", s[sp], f); break;
        CA(7) "unmatched ')' at byte %d of %s", q, f); break;
        CA(8) "can't open %s", f); break;
        CA(9) "unmatched '{' at byte %d of %s", s[sp], f); break;
        CA(10) "unmatched '}' at byte %d of %s", q, f); break;
        CA(11) "unmatched '\"' at byte %d of %s", q, f); break;
        CA(12) "divide by zero at byte %d of %s", q, f); break;
    }
    fprintf(stderr, ".\n");
    scale=0;
    return(i);
}

long callcms(long val) {
    int cnt = 0;
    int lim = 130;
    char cmsstr[130], *d=cmsstr;
    int r=0;
    while ((tmp=(code[++q]!='"')) && (q<length) && (++cnt<lim)) *d++=code[q];
    if (tmp) {e(11); return(0);}
    *d++=0;
    r = __cmscmd(cmsstr, 1 /* CMS_COMMAND */);
    return r;
}

void cbhelp(long cb) {
    if (cb == 1020) { /* Location is...*/
        fprintf(stdout, "current cell is %05d: %6ld\n", p, a[p]);
        return;
    }
    if (cb == 1028) { /* Identify yourself */
        fprintf(stdout, "cbrain CMS v%3.2f\n", VERSION);
        return;
    }
    if (cb == 1036) { /* Help for CB code 10-36, current time is... */
        time_t now;
        time(&now);
        fprintf(stdout, "%s\n", ctime(&now));
        return;
    }
    fprintf(stdout, "cbrain CMS v%3.2f\n", VERSION);
    fprintf(stdout, "------------\n");
    fprintf(stdout, "bf    :  + - > < [ ] , .\n");
    fprintf(stdout, "pbrain:  ( ) :\n");
    fprintf(stdout, "cbrain:  { } 0 1 2 3 4 5 6 7 8 9\n");
    fprintf(stdout, "         * / ??' & | ??- %% @ ! # = \"\n");
    fprintf(stdout, "         a b c d e f g h l m n o\n");
    fprintf(stdout, "         p q r s t x z '\n");
    fprintf(stdout, "HELP | FILE name type [mode], in column 1\n");
    fprintf(stdout, "Look in CBRAIN HELPCMD for more details\n");
    return;
}

int cbrain(long *a, char *args){
    if ((strncmp("HELP", args, 4) == 0) || (strncmp("help", args, 4) == 0)) {
        cbhelp(a[p]);
        return 0;
    } else if ((strncmp("FILE ", args, 5) == 0) || (strncmp("file ", args, 5) == 0)){
        if (args[strlen(args)-1] == '\n') args[strlen(args)-1] = '\0';
        args += 5;
        if(!(input = fopen(f=args, "r"))) { e(8); return(0); }
        length = fread(code, 1, SIZE, input);
        fclose(input);
        memset(a, 0, SIZE);
    } else {
        f = "cbrain";
        length=strlen(args);
        strncpy(code, args, SIZE);
    }
    /* Start up cbrain */
    quit=0;
    scale=0;
    for(q=0;q<length;q++){
        switch(code[q]){
            case '(': case '[': s[sp++]=q; break;
            case ')': if(!sp--||code[s[sp]]!='(') {e(7); return(0);} t[s[sp]]=q; break;
            case ']': if(!sp--||code[t[t[s[sp]]=q]=s[sp]]!='[') {e(5); return(0);} break;
        }
    }
    if(sp) e(code[s[--sp]]=='['?4:6);
    for(q=0;q<=PROCEDURES;q++) ptable[q]=-1;
    for(q=0;q<length;q++){
        if (tracer && !isspace(code[q])) {
            tmp=isgraph(code[q])?code[q]:'.';
            fprintf(stderr, "[Tracing: %04d '%c' at %05d: %6ld, ", q, (char)tmp, p, a[p]);
            tracing=1;
        }
        switch(code[q]){
            /* bf */
            case '+': a[p]++; scale=0; break;
            case '-': a[p]--; scale=0; break;
            case '<': if(--p<0) {e(3); p=0; return(0);} scale=0; break;
            case '>': if(++p>=SIZE) {e(3); p=SIZE; return(0);} scale=0; break;
            case '.': fputc(a[p]==10?'\n':a[p], stdout); scale=0; break;
            case ',': if((c=fgetc(stdin))!=EOF) a[p]=c=='\n'?10:c; scale=0; break;
            case '[': if(!a[p]) q=t[q]; scale=0; break;
            case ']': if(a[p]) q=t[q]; scale=0; break;
            /* pbrain */
            case '(': ptable[a[p]]=q; q=t[q]; scale=0; break;
            case ')': q=s[--sp]; scale=0; break;
            case ':': s[sp++]=q; if((q=ptable[a[p]])<0) e(2); scale=0; break;
            /* cbrain */
            case '{': tmp=1; while(tmp&&q++<length) {tmp-=(code[q]=='}'); tmp+=(code[q]=='{');} if(tmp) {e(9); return(0);} scale=0; break;
            case '}': e(10); return(0); scale=0; break;
            case '*': a[p]*=10; scale=0; break;
            case '/': a[p]/=10; scale=0; break;
            case '&': if(p<1) {e(3); return(0);} a[--p]&=a[p+1]; scale=0; break;
            case '|': if(p<1) {e(3); return(0);} a[--p]|=a[p+1]; scale=0; break;
            case '??'': if(p<1) {e(3); return(0);} a[--p]??'=a[p+1]; scale=0; break;
            case '??-': a[p]=??-a[p]; scale=0; break;
            case '$': a[p]=(float)a[p]; scale=0; break;
            case 'a': case 'A': if(p<1) {e(3); return(0);} a[--p]+=a[p+1]; scale=0; break;
            case 's': case 'S': if(p<1) {e(3); return(0);} a[--p]-=a[p+1]; scale=0; break;
            case 'm': case 'M': if(p<1) {e(3); return(0);} a[--p]*=a[p+1]; scale=0; break;
            case 'd': case 'D': if(p<1) {e(3); return(0);} if(a[p]) {tmp=a[p-1]; a[p-1]/=a[p]; a[p]=tmp-a[p]*a[p-1];} scale=0; break;
            case '%': if(p<1) {e(3); return(0);} a[--p]%=a[p+1]; scale=0; break;
            case 'r': case 'R': if(p<1) {e(3); return(0);} a[--p]>>=a[p+1]; scale=0; break;
            case 'l': case 'L': if(p<1) {e(3); return(0);} a[--p]<<=a[p+1]; scale=0; break;
            case '0': a[p]*=(scale++>0)?10:0; break;
            case '1': a[p]*=(scale++>0)?10:0; a[p]+=1; break;
            case '2': a[p]*=(scale++>0)?10:0; a[p]+=2; break;
            case '3': a[p]*=(scale++>0)?10:0; a[p]+=3; break;
            case '4': a[p]*=(scale++>0)?10:0; a[p]+=4; break;
            case '5': a[p]*=(scale++>0)?10:0; a[p]+=5; break;
            case '6': a[p]*=(scale++>0)?10:0; a[p]+=6; break;
            case '7': a[p]*=(scale++>0)?10:0; a[p]+=7; break;
            case '8': a[p]*=(scale++>0)?10:0; a[p]+=8; break;
            case '9': a[p]*=(scale++>0)?10:0; a[p]+=9; break;
            case ' ': if(scale>0) {if(++p>=SIZE) {e(3); p=SIZE; return(0);}} scale=0; break;
            case 'z': a[p]=-a[p]; if(scale>0) {if(++p>=SIZE) {e(3); p=SIZE; return(0);}} scale=0; break;
            case '=': scanf("%d", &a[p]); scale=0; break;
            case 'n': case 'N': fprintf(stdout, "%d", a[p]); scale=0; break;
            case 'h': case 'H': fprintf(stdout, "%x", a[p]); scale=0; break;
            case 'b': case 'B': fprintf(stdout, "%32s", long_to_binary(a[p])); scale=0; break;
            case 'f': case 'F': fprintf(stdout, "%f", (float)a[p]); scale=0; break;
            case '#': fprintf(stdout, "%03ld", a[p]); scale=0; break;
            case 'e': case 'E': fputc(' ', stdout); scale=0; break;
            case 'p': case 'P': fputc('\n', stdout); scale=0; break;
            case 'x': case 'X': tmp=a[p];a[p]=a[p-1];a[p-1]=tmp; scale=0; break;
            case 'c': case 'C': if(p>=SIZE) {e(3); return(0);} a[++p]=a[p-1]; scale=0; break;
            case 'o': case 'O': if(p<1||p>=SIZE) {e(3); return(0);} a[++p]=a[p-2]; scale=0; break;
            case '@': memreg=a[p]; scale=0; break;
            case '!': a[p]=memreg; scale=0; break;
            case '"': a[p]=callcms(a[p]); scale=0; break;
            case '\'': a[p]=(q+1<length)?code[++q]:0; scale=0; break;
            case '?': tmp=p; while(tmp-->=0) fprintf(stdout, "[%05d: %6ld]\n", tmp+1, a[tmp+1]); scale=0; break;
            case 't': case 'T': tracer=(tracer?0:1); scale=0; break;
            case 'g': case 'G': return (a[p]);
            case 'q': case 'Q': quit=1; return(0);
            default: scale=0;
        }
        if (tracing && !isspace(code[q])) {
            fprintf(stderr, " after %05d: %6ld]\n", p, a[p]);
            tracing=0;
        }
    }
    return(a[p]);
}

int main(int argc, char *argv[]) {
    char *line;
    long rc = 0;

    line = malloc(255);
    if (line && (argc > 1)) {
        line[0] = '\0';
        strcat(line, "FILE ");
        strncat(line, argv[1], 8);
        strcat(line, " CB A");
        rc = cbrain(a, line);
        fflush(stderr);
        fflush(stdout);
    }
    while (line && !quit) {
        line = fgets(line, 255, stdin);
        rc = cbrain(a, line);
        fflush(stderr);
        fflush(stdout);
        clearerr(stdin);
    }
    free(line);
    return rc;
}