Computer Science Canada

cbrain, cbrain run

Author:  btiffin [ Fri Mar 29, 2013 2:05 am ]
Post subject:  cbrain, cbrain run

Bumped into pbrain.c on esolangs.org. Nice. Extended it with intent of CALLing from COBOL. Adds bitwise integer ops like xor, which is kinda klunky in COBOL.

Esoteric programming is a lot of fun.

pbrain adds labeled procedures to brainf**k (a name I'm not a fan of), so I'll just reference pbrain.

I've cheated on pbrain and allow numbers, binary ops, a few 'stack' ops like o for over.

code:

/* 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 with OpenCOBOL as
   cbrain

   btiffin (https://sourceforge.net/users/btiffin)
   Tectonics: cobc -x callcbrain.cob cbrain.c
              01 brain-cells.
                 05 brain-cell usage binary-c-long occurs 65546 times.
              CALL "cbrain" USING brain-cells
                  BY CONTENT "file pathname" & x"00"
               or
                  BY CONTENT "{cbrain source text} 99 . 10 ." & x"00"
                  RETURNING cell
              END-CALL
              DISPLAY brain-cell(cell) END-DISPLAY
*/

#include <ctype.h>
#include <string.h>
#include <stdio.h>
#include <limits.h>
#include <stdlib.h>
#define SIZE 65536
#define CA(x) case x: fprintf(stderr, "Error: "

//unsigned short a[SIZE];
long a[SIZE];
int s[SIZE], sp, ptable[USHRT_MAX+1], t[SIZE], p, q, length, c, tmp, scale, tracer, tracing;
char code[SIZE], *f, bin[sizeof(long)*8+1];
FILE *input;

const char *long_to_binary(unsigned long x) {
    unsigned long z;
    char *d = bin;
    for (z = (unsigned long)1<<(sizeof(long)*8-1); z > 0; z >>= 1)
        *d++ = ((x & z) == z) ? '1' : '0';
    *d++ = '\0';
    return bin;
}

void 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;
    }
    printf(".\n");
    exit(i);
}

int cbrain(long *a, char *args){
    if (strncmp("file ", args, 5) == 0) {
        args += 5;
        if(!(input = fopen(f=args, "r"))) e(8);
        length = fread(code, 1, SIZE, input);
        fclose(input);
    } else {
        f = "cbrain";
        length=strlen(args);
        strncpy(code, args, SIZE);
    }
    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); t[s[sp]]=q; break;
            case ']': if(!sp--||code[t[t[s[sp]]=q]=s[sp]]!='[') e(5); break;
            case '{': while(q++<length && code[q]!='}'); if (q>=length) e(9); break;
            case '}': e(10); break;
        }
    }
    if(sp) e(code[s[--sp]]=='['?4:6);
    for(q=0;q<=USHRT_MAX;q++) ptable[q]=-1;
    for(q=0;q<length;q++){
        if (tracer && !isspace(code[q])) {
            tmp=isgraph(code[q])?code[q]:'.';
            fprintf(stderr, "[%05d %c at %05d was %9lu, ", q, (char)tmp, p, a[p]);
            tracing=1;
        }
        switch(code[q]){
            case '{': while(q++<length && code[q]!='}'); scale=0; break;
            case '}': e(10); break;
            case '+': a[p]++; scale=0; break;
            case '-': a[p]--; scale=0; break;
            case '*': a[p]*=10; scale=0; break;
            case '/': a[p]/=10; scale=0; break;
            case '&': if(p<1) e(3); a[p-1]&=a[p--]; scale=0; break;
            case '|': if(p<1) e(3); a[p-1]|=a[p--]; scale=0; break;
            case '^': if(p<1) e(3); a[p-1]^=a[p--]; scale=0; break;
            case '~': a[p]=~a[p]; scale=0; break;
            case 'a': if(p<1) e(3); a[p-1]+=a[p--]; scale=0; break;
            case 's': if(p<1) e(3); a[p-1]-=a[p--]; scale=0; break;
            case 'm': if(p<1) e(3); a[p-1]*=a[p--]; scale=0; break;
            case 'd': if(p<1) e(3); a[p-1]/=a[p--]; scale=0; break;
            case '%': if(p<1) e(3); a[p-1]%=a[p--]; scale=0; break;
            case 'r': if(p<1) e(3); a[p-1]>>=a[p--]; scale=0; break;
            case 'l': if(p<1) e(3); a[p-1]<<=a[p--]; 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(--p<0) e(3); scale=0; break;
            case '>': if(++p>=SIZE) e(3); scale=0; break;
            case ',': if((c=getchar())!=EOF) a[p]=c=='\n'?10:c; scale=0; break;
            case '=': scanf("%d", &a[p]); scale=0; break;
            case '.': putchar(a[p]==10?'\n':a[p]); scale=0; break;
            case '#': printf("%+09d ", a[p]); scale=0; break;
            case 'b': printf("%64s ", long_to_binary(a[p])); scale=0; break;
            case '[': if(!a[p]) q=t[q]; scale=0; break;
            case ']': if(a[p]) q=t[q]; scale=0; break;
            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;
            case 'c': if(++p>=SIZE) e(3); a[p]=a[p-1]; scale=0; break;
            case 'o': if(p<2||++p>=SIZE) e(3); a[p]=a[p-2]; scale=0; break;
            case 'x': tmp=a[p];a[p]=a[p-1];a[p-1]=tmp; scale=0; break;
            case 't': tracer=(tracer?0:1); scale=0; break;
            case 'g': return (p+1);
            case 'q': exit(0);
            default: scale=0;
        }
        if (tracing && !isspace(code[q])) {
            fprintf(stderr, " after %05d is %9lu]\n", p, a[p]);
            tracing=0;
        }
    }
    /* COBOL is an ordinal language, first is 1 */
    return(p+1);
}


A sample of
code:

[-][old school]
+++++ +++++             
[                       
    > +++++ ++         
    > +++++ +++++       
    > +++               
    > +                 
    <<<< -             
]                       
> ++ .                 
> + .                   
+++++ ++ .             
.                       
+++ .                   
> ++ .                 
<< +++++ ++ .           
> + .                   
----- ----- - .         
+++++ ++++ .           
< ----- ----- -- .     
+++++ +++++ ++ .       
----- ----- --- .       
+++++ +++++ +++ .       
--- .                   
>> + .                 
> .                     

0[eso style]
39
> 83
> 117
> 112
> 32
> 101
> 97
> 114
> 116
> 104
> 0
< < < < < < < < < <
[. >]
> 01 * .

{cbrain style}0(<<<<<<<<<<)>72>101>7oacc+++>32>99c->114o->105c>5a>32>0:<<<[.>]<<[.<]10.

giving
code:

Hello OpenCOBOL!
'Sup earth
Hello cbrain niarbc olleH


Called from COBOL
code:

OCOBOL >>SOURCE FORMAT IS FIXED
      *> *******************************************************
      *> Author:    Brian Tiffin
      *> Date:      20130326
      *> Purpose:   cbrain
      *> Tectonics: cobc -x callcbrain.cob cbrain.c
      *> *******************************************************
       identification division.
       program-id. callcbrain.

       data division.
       working-storage section.
       01 cbrain-cmd           pic x(132).
       01 string-cell          pic z(19)9.
       01 fielded-variable     pic xxx.
       01 cell                 pic s9(8).
       01 looper               pic s9(8).
       01 brain-cells.
          05 brain-cell usage binary-c-long occurs 65536 times.

      *> *******************************************************
       procedure division.
       initialize brain-cells       
       call "cbrain" using brain-cells
           by content "file bitwise.cb" & x"00"
           returning cell
       end-call
       display "OC: from bitwise.cb " brain-cell(cell) end-display

       call "cbrain" using brain-cells
           by content "127 > 85 ^" & x"00"
           returning cell
       end-call
       display "OC: from expression " brain-cell(cell) end-display

       call "cbrain" using brain-cells
           "{127 xor 85}" &
           "{define procedure 1 for newline}" &
           "0+(> 10 . <)" &
           "{place 127 in memory 0," &
           "  place 85 in memory 1," &
           "  bitwise XOR," &
           "  display as number." &
           "  Then, call procedure 1 for a newline," &
           "  advancing and retreating}" &
           "127" &
           "> 85 ^ #" &
           "> 1 : <" & x"00"
           returning cell
       end-call
       display "OC: 127 xor 85 = " brain-cell(cell) end-display

       initialize brain-cells       
       call "cbrain" using brain-cells
           by content "file morehello.cb" & x"00"
           returning cell
           on exception continue
       end-call

       initialize brain-cells       
       call "cbrain" using brain-cells
           by content "file pbrains.cb" & x"00"
           returning cell
           on exception continue
       end-call

      *> this is why bitwise might actually get written someday
       move 123 to fielded-variable
       initialize brain-cells
       call "cbrain" using brain-cells
           by content function concatenate(
               fielded-variable
               "> 31 &", x"00")
           returning cell
       end-call
       display "OC: fielded-variable " fielded-variable " and 31 is "
           brain-cell(cell)
       end-display

       perform varying looper from 1 by 1 until looper > 5
           move looper to string-cell
           string
               string-cell delimited by size
               " > 91 a #  > 38 . 32 . <  > 31 # &  > 61 . 32 . < # b" &
               " > 10 . <"  delimited by size
               x"00" delimited by size
               into cbrain-cmd
               on overflow
                   display "too much brain" end-display
           end-string

           initialize brain-cells
           call "cbrain" using brain-cells
               by content cbrain-cmd
               returning cell
               on exception continue
           end-call
      *    display "OC: " brain-cell(cell) end-display
       end-perform
       
       goback.
       end program callcbrain.


with a cbrain run of

code:

[cbrain]$ cobc -x callcbrain.cob cbrain.c
[cbrain]$ ./callcbrain
+00000008
+00000014
+00000015
-00000009
+00000015
+00000001
+00000003
[00244 0 at 00014 was         1,  after 00014 is         0]
[00246 { at 00014 was         0,  after 00014 is         0]
[00293 + at 00014 was         0,  after 00014 is         1]
[00294 + at 00014 was         1,  after 00014 is         2]
[00295 + at 00014 was         2,  after 00014 is         3]
[00296 + at 00014 was         3,  after 00014 is         4]
[00297 + at 00014 was         4,  after 00014 is         5]
[00299 > at 00014 was         5,  after 00015 is        10]
[00301 0 at 00015 was        10,  after 00015 is         0]
[00303 + at 00015 was         0,  after 00015 is         1]
[00304 + at 00015 was         1,  after 00015 is         2]
[00305 + at 00015 was         2,  after 00015 is         3]
[00306 + at 00015 was         3,  after 00015 is         4]
[00307 + at 00015 was         4,  after 00015 is         5]
[00308 + at 00015 was         5,  after 00015 is         6]
[00309 + at 00015 was         6,  after 00015 is         7]
[00310 + at 00015 was         7,  after 00015 is         8]
[00311 + at 00015 was         8,  after 00015 is         9]
[00312 + at 00015 was         9,  after 00015 is        10]
[00314 * at 00015 was        10,  after 00015 is       100]
[00316 m at 00015 was       100,  after 00014 is       500]
[00318 > at 00014 was       500,  after 00015 is       100]
[00320 5 at 00015 was       100,  after 00015 is         5]
[00321 5 at 00015 was         5,  after 00015 is        55]
[00323 a at 00015 was        55,  after 00014 is       555]
[00325 * at 00014 was       555,  after 00014 is      5550]
[00326 * at 00014 was      5550,  after 00014 is     55500]
[00327 * at 00014 was     55500,  after 00014 is    555000]
[00328 * at 00014 was    555000,  after 00014 is   5550000]
[00329 * at 00014 was   5550000,  after 00014 is  55500000]
[00330 * at 00014 was  55500000,  after 00014 is 555000000]
[00332 # at 00014 was 555000000,  after 00014 is 555000000]
[00334 t at 00014 was 555000000,  after 00014 is 555000000]
+555000000
OC: from bitwise.cb +00000000000555000000
OC: from expression +00000000000000000042
+00000042
OC: 127 xor 85 = +00000000000000000042
Hello OpenCOBOL!
'Sup earth
Hello cbrain niarbc olleH
8
ABCDE
EsoAPI required
OC: fielded-variable 123 and 31 is +00000000000000000027
+00000092 & +00000031 = +00000028 0000000000000000000000000000000000000000000000000000000000011100
+00000093 & +00000031 = +00000029 0000000000000000000000000000000000000000000000000000000000011101
+00000094 & +00000031 = +00000030 0000000000000000000000000000000000000000000000000000000000011110
+00000095 & +00000031 = +00000031 0000000000000000000000000000000000000000000000000000000000011111
+00000096 & +00000031 = +00000000 0000000000000000000000000000000000000000000000000000000000000000


Way fun.

Cheers

Author:  Tony [ Fri Mar 29, 2013 2:19 am ]
Post subject:  Re: cbrain, cbrain run

btiffin @ Fri Mar 29, 2013 2:05 am wrote:
Extended it with intent of CALLing from COBOL. Adds bitwise integer ops like xor, which is kinda klunky in COBOL.


I'm not entirely sure as to what's going on, but if inlining pbrain / brainfuck is making anything _easier_, then... uhhh... COBOL!

Author:  btiffin [ Fri Mar 29, 2013 9:42 am ]
Post subject:  Re: cbrain, cbrain run

Smile

Not really expecting anything resembling production usage, except for the laughs and looks of dismay, but COBOL without BIT support is kinda klunky for XORing integers. We'll have true BIT support in the OpenCOBOL compiler someday, but for now, this opens a fairly quick and not overly bloated path to getting at bitwise ops with my favourite compiler. Hopefully it's at least as useful as the embedded Shakespeare and beatnik engines.

Mostly, was a way to while away some insomnia. Fun. http://esolangs.org/wiki/Cbrain

Cheers


: