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 |
