cbrain, cbrain run
Author |
Message |
btiffin
|
Posted: 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 |
|
|
|
|
|
Sponsor Sponsor
|
|
|
Tony
|
Posted: 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! |
Tony's programming blog. DWITE - a programming contest. |
|
|
|
|
btiffin
|
Posted: Fri Mar 29, 2013 9:42 am Post subject: Re: cbrain, cbrain run |
|
|
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 |
|
|
|
|
|
|
|