Befunge-93 interpreter

DOS specific questions.
rugxulo
Posts: 216
Joined: Jun 30, 2006 5:31
Location: Usono (aka, USA)
Contact:

Befunge-93 interpreter

Postby rugxulo » Jan 05, 2011 7:51

Useless, trivial, annoying, but enjoy anyways! :-)

http://catseye.tc/projects/bef.html
http://en.wikipedia.org/wiki/Befunge
http://www.esolangs.org/wiki/Befunge

Code: Select all

' $lang: "qb"
'
' Befunge-93 interpreter in FreeBASIC 0.21.1
'
' Monday, January 3, 2011
'
'   LICENSE/AUTHOR:
'     = public domain, nenies proprajho, "!! Christus Rex !!"
'     = rugxulo _AT_ gmail _DOT_ com
'   HISTORY:
'     = v1.0 -- semi tested to work fairly well but not fully
'     = v1.1 -- fixed to (also) compile in lang qb
'   BUGS:
'     = still not fixed to work with real QBASIC 1.0 (yet)
'       = ugh, much harder than I thought (why??)  :-/

CONST xmax = 80, ymax = 25, stackmax = 1000
DIM SHARED ch AS STRING, chartemp AS STRING
DIM SHARED bspace(1 TO ymax) AS STRING * 80
DIM SHARED stack(1 TO stackmax) AS LONG
DIM SHARED a AS LONG, b AS LONG, c AS LONG
DIM SHARED x AS INTEGER, y AS INTEGER, strmode AS INTEGER
DIM SHARED xdelta AS INTEGER, ydelta AS INTEGER, sp AS INTEGER

FUNCTION pop() AS LONG
  IF (sp < stackmax) THEN
    sp = sp + 1 : pop = stack(sp)
  ELSE
    pop = 0
  END IF
END FUNCTION 'pop

SUB nop()
  a = 0
END SUB 'nop

SUB delta(xd AS INTEGER, yd AS INTEGER)
  xdelta = xd : ydelta = yd
END SUB 'delta

SUB push(m AS LONG)
  stack(sp) = m : IF (sp > 1) THEN sp = sp - 1
END SUB 'push

SUB ClearStack()
  DIM s AS INTEGER

  FOR s = 1 TO stackmax
    stack(s) = 0
  NEXT s
END SUB 'ClearStack

SUB ClearBspace()
  DIM b AS INTEGER

  FOR b = 1 TO ymax
    bspace(b) = SPACE$(xmax)
  NEXT b
END SUB 'ClearBspace

SUB ReadB93File()
  DIM eg AS INTEGER, f AS INTEGER, z AS INTEGER, q AS INTEGER
  DIM filename AS STRING

  eg = FREEFILE : f = 1
  filename = "example.bef"

' ************************************************
  IF COMMAND$(1) <> "" THEN filename = COMMAND$(1)
' ************************************************

  OPEN filename FOR INPUT AS #eg
  IF ERR > 0 THEN
    ? "ERROR: Couldn't open " + """" + filename + """"
    SYSTEM 255
  END IF

    DO UNTIL EOF(eg)
      bspace(f) = SPACE$(xmax)
      LINE INPUT #eg, bspace(f)
      f = f + 1
    LOOP

    FOR z = 1 to f
      q = INSTR(bspace(z),CHR$(0))-1
      bspace(z) = MID$(bspace(z),1,q) + SPACE$(xmax-q)
    NEXT z

  CLOSE #eg
END SUB 'ReadB93File

' ==============================================================
SUB B93Debug()
  DIM d AS INTEGER

  ? " x,y = " + LTRIM$(STR$(x)) + "," + RTRIM$(STR$(y));

  IF (ch <> """") THEN
    ? " ch = """ + ch + """";
  ELSE
    ? " ch = '" + ch + "'";
  END IF

  FOR d = 1 TO 4
    IF ((sp+d) <= stackmax) THEN
      ? stack(sp+d);
    END IF
  NEXT d

  IF (strmode) THEN
    ? " """""""""
  ELSE
    ?
  END IF
END SUB 'B93Debug

SUB ShowBspace()
  DIM b AS INTEGER

  FOR b = 1 TO ymax
    ? bspace(b)
  NEXT b
  SYSTEM
END SUB 'ShowBspace
' ==============================================================

' BEGIN bef93

x = -1 : y = 0 : delta(1,0) : sp = stackmax : strmode = 0

RANDOMIZE TIMER : ClearStack() : ClearBspace() : ReadB93File()
' ShowBspace()

DO ' main loop

x = x + xdelta : y = y + ydelta

' wrap if necessary
IF (x > xmax-1) THEN
  x = 0
ELSEIF (y > ymax-1) THEN
  y = 0
ELSEIF (x < 0) THEN
  x = xmax-1
ELSEIF (y < 0) THEN
  y = ymax-1
END IF

ch = MID$(bspace(y+1),x+1,1)
' B93Debug()

IF (strmode) AND (ch <> """") THEN
  push(ASC(ch))
END IF

IF (ch = """") THEN
  strmode = NOT strmode
END IF

IF NOT strmode THEN

SELECT CASE ch
CASE "?" : a = INT(RND * 4) + 1
  SELECT CASE a
    CASE 1 : delta(0,-1)
    CASE 2 : delta(0,1)
    CASE 3 : delta(-1,0)
    CASE 4 : delta(1,0)
  END SELECT
CASE "0" TO "9" : push(ASC(ch)-ASC("0"))
CASE "." : a=pop() : ? LTRIM$(STR$(a)) + " ";
CASE "," : a=pop() : IF (a = 10) THEN ? : ELSE ? CHR$(a);
CASE "v" : delta(0,1)
CASE "^" : delta(0,-1)
CASE "<" : delta(-1,0)
CASE ">" : delta(1,0)
CASE "#" : x = x + xdelta : y = y + ydelta
CASE "_"
  a=pop() : IF (a <> 0) THEN delta(-1,0) : ELSE delta(1,0)
CASE "|"
  a=pop() : IF (a <> 0) THEN delta(0,-1) : ELSE delta(0,1)
CASE "`"
  b=pop() : a=pop() : IF (a > b) THEN push(1) ELSE push(0)
CASE "!" : a=pop() : IF (a = 0) THEN push(1) ELSE push(0)
CASE "\" : a=pop() : b=pop() : push(a) : push(b)
CASE ":" : a=pop() : push(a) : push(a)
CASE "$" : a=pop()
CASE "+" : b=pop() : a=pop() : push(a + b)
CASE "-" : b=pop() : a=pop() : push(a - b)
CASE "*" : b=pop() : a=pop() : push(a * b)
CASE "/" : b=pop() : a=pop() : push(a \ b) ' integer divide
CASE "%" : b=pop() : a=pop() : push(a MOD b)
CASE "~" : INPUT ; chartemp : push(ASC(chartemp))
CASE "&" : INPUT a : push(a)
CASE "g" : b=pop() : a=pop() : c = ASC(MID$(bspace(b+1),a+1,1))
           push(c)
CASE "p" : b=pop() : a=pop() : c=pop()
           MID$(bspace(b+1),a+1,1) = CHR$(c)
CASE "@" : SYSTEM
CASE ELSE : nop()
END SELECT
END IF ' NOT strmode
LOOP ' DO

' END bef93
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Postby rdc » Jan 05, 2011 11:32

Very cool. I never did grasp Befunge. It is just to esoteric for me I guess. :)
rugxulo
Posts: 216
Joined: Jun 30, 2006 5:31
Location: Usono (aka, USA)
Contact:

Postby rugxulo » Jan 05, 2011 14:26

It's just for fun, not "real work", so there's really not much to learn!

Frotz (or similar Z machine) can interpret Zbefunge or Zedfunge with debugging capabilities, which makes things a whole lot clearer when you're just starting out. (And yes, there's a DOS/DJGPP port.)
rugxulo
Posts: 216
Joined: Jun 30, 2006 5:31
Location: Usono (aka, USA)
Contact:

Postby rugxulo » Jul 11, 2011 16:49

Here's a minor update with better QB compatibility. (Hence I'm also leaving the old one since it erroneously thinks it's QB compatible when in -lang qb. Note also that -lang qb seems to add 40 kb to the .EXE even though I'm not doing anything specific to it, heh.)

BTW, this probably doesn't belong exclusively in the DOS subform, my bad, but my obvious bias didn't even think about it (though I did test with Win32 a tiny bit).

Code: Select all

' $lang: "qb"
'
' Befunge-93 interpreter in QBASIC (1.0), FreeBASIC (0.22.0)
'
' Monday, June 27, 2011
'
'   LICENSE/AUTHOR:
'     = public domain, nenies proprajho, "!! Christus Rex !!"
'     = rugxulo _AT_ gmail _DOT_ com
'   HISTORY:
'     = v1.0 -- semi tested to work fairly well but not fully
'     = v1.1 -- fixed to also compile in lang qb (but not real QB)
'     = v1.2 -- replaced "INPUT ; chartemp" with "chartemp = INKEY$"
'     = v1.3 -- fixed to more or less runs in QB and FBC
'   BUGS:
'     = QBASIC 1.0 more or less runs it now ... with minor bugs
'       = QB needs CR+LF EXAMPLE.BEF file as default (ugh)
'       = apparently function syntax is incompatible with -lang fb
'         = but two very minor changes and then it works fine
'       = does "900p" work? what about "99*6-0g,@" ??
'         = in FBC, no; in QB, yes (why??)
'           = either fix here or include new test for this ??

CONST xmax = 80, ymax = 25, stackmax = 1000
DIM SHARED ch AS STRING, chartemp AS STRING
DIM SHARED bspace(1 TO ymax) AS STRING * 80
DIM SHARED stack(1 TO stackmax) AS LONG
DIM SHARED a AS LONG, b AS LONG, c AS LONG
DIM SHARED x AS INTEGER, y AS INTEGER, strmode AS INTEGER
DIM SHARED xdelta AS INTEGER, ydelta AS INTEGER, sp AS INTEGER

DECLARE SUB ClearBspace()
DECLARE SUB ClearStack()
DECLARE SUB delta (xd AS INTEGER, yd AS INTEGER)
DECLARE SUB nop()
DECLARE SUB push(m AS LONG)
DECLARE SUB ReadB93File()
'DECLARE FUNCTION pop() AS LONG   ' FreeBASIC (native mode)
DECLARE FUNCTION pop&()           ' QBASIC

' ==============================================================

' BEGIN bef93

x = -1 : y = 0 : delta 1, 0 : sp = stackmax : strmode = 0

RANDOMIZE TIMER : ClearStack : ClearBspace : ReadB93File
' ShowBspace

DO ' main loop

  x = x + xdelta : y = y + ydelta

' wrap if necessary
  IF (x > xmax - 1) THEN
    x = 0
  ELSEIF (y > ymax - 1) THEN
    y = 0
  ELSEIF (x < 0) THEN
    x = xmax - 1
  ELSEIF (y < 0) THEN
    y = ymax - 1
  END IF

  ch = MID$(bspace(y+1),x+1,1)
' B93Debug

  IF (strmode) AND (ch <> CHR$(&H22)) THEN push(ASC(ch))

  IF (ch = CHR$(&H22)) THEN strmode = NOT strmode

  IF NOT strmode THEN

  SELECT CASE ch
  CASE "?": a = INT(RND * 4) + 1
    SELECT CASE a
      CASE 1: delta 0, -1
      CASE 2: delta 0, 1
      CASE 3: delta -1, 0
      CASE 4: delta 1, 0
    END SELECT
  CASE "0" TO "9": push(ASC(ch) - ASC("0"))
  CASE ".": a = pop : ? LTRIM$(STR$(a)) + " " ;
  CASE ",": a = pop : IF (a = 10) THEN ? ELSE ? CHR$(a) ;
  CASE "v": delta 0, 1
  CASE "^": delta 0, -1
  CASE "<": delta -1, 0
  CASE ">": delta 1, 0
  CASE "#": x = x + xdelta : y = y + ydelta
  CASE "_": a = pop
            IF (a <> 0) THEN delta -1, 0 ELSE delta 1, 0
  CASE "|": a = pop
            IF (a <> 0) THEN delta 0, -1 ELSE delta 0, 1
  CASE "`": b = pop : a = pop : IF (a > b) THEN push(1) ELSE push(0)
  CASE "!": a = pop : IF (a = 0) THEN push(1) ELSE push(0)
  CASE "\": a = pop : b = pop : push(a) : push(b)
  CASE ":": a = pop : push(a) : push(a)
  CASE "$": a = pop
  CASE "+": b = pop : a = pop : push(a + b)
  CASE "-": b = pop : a = pop : push(a - b)
  CASE "*": b = pop : a = pop : push(a * b)
  CASE "/": b = pop : a = pop : push(a \ b) ' integer divide
  CASE "%": b = pop : a = pop : push(a MOD b)
  CASE "~": DO : chartemp = INKEY$ : LOOP UNTIL chartemp <> ""
            push(ASC(chartemp))
  CASE "&": INPUT a : push(a)
  CASE "g": b = pop : a = pop : c = ASC(MID$(bspace(b+1),a+1,1))
            push(c)
  CASE "p": b = pop : a = pop : c = pop
            MID$(bspace(b+1),a+1,1) = CHR$(c)
  CASE "@": SYSTEM
  CASE ELSE: nop
  END SELECT

  END IF ' NOT strmode
LOOP ' DO

' END bef93

' ==============================================================

SUB B93Debug
  DIM d AS INTEGER

  ? " x,y = " + LTRIM$(STR$(x)) + "," + RTRIM$(STR$(y)) ;

  IF (ch <> CHR$(&H22)) THEN
    ? " ch = " + CHR$(&H22) + ch + CHR$(&H22)
  ELSE
    ? " ch = '" + ch + "'" ;
  END IF

  FOR d = 1 TO 4
    IF ((sp + d) <= stackmax) THEN ? stack(sp + d) ;
  NEXT d

  IF (strmode) THEN ? " " + STRING$(4, CHR$(&H22)) ELSE ?
END SUB 'B93Debug

SUB ClearBspace
  FOR b = 1 TO ymax
    bspace(b) = SPACE$(xmax)
  NEXT b
END SUB 'ClearBspace

SUB ClearStack
  DIM s AS INTEGER

  FOR s = 1 TO stackmax
    stack(s) = 0
  NEXT s
END SUB 'ClearStack

SUB delta (xd AS INTEGER, yd AS INTEGER)
  xdelta = xd : ydelta = yd
END SUB 'delta

SUB nop
  a = 0
END SUB 'nop

'FUNCTION pop() AS LONG   ' FreeBASIC (native mode)
FUNCTION pop&             ' QBASIC
  IF (sp < stackmax) THEN
    sp = sp + 1 : pop = stack(sp)
  ELSE
    pop = 0
  END IF
END FUNCTION 'pop

SUB push(m AS LONG)
  stack(sp) = m : IF (sp > 1) THEN sp = sp - 1
END SUB 'push

SUB ReadB93File
  DIM eg AS INTEGER, f AS INTEGER, z AS INTEGER, q AS INTEGER
  DIM filename AS STRING

  eg = FREEFILE : f = 1
  filename = "example.bef"

' this needs to be commented out for QBASIC 1.0, sadly  :-(
' ************************************************
' IF COMMAND$(1) <> "" THEN filename = COMMAND$(1)
' ************************************************

  OPEN filename FOR INPUT AS #eg
  IF ERR > 0 THEN
    ? "ERROR: Couldn't open " + filename
    SYSTEM
  END IF

    DO UNTIL EOF(eg)
      bspace(f) = SPACE$(xmax)
      LINE INPUT #eg, bspace(f)
      f = f + 1
    LOOP

    FOR z = 1 TO f
      bspace(z) = bspace(z) + SPACE$(xmax - LEN(bspace(z)))
    NEXT z

  CLOSE #eg
END SUB 'ReadB93File

SUB ShowBspace
  FOR b = 1 TO ymax
    ? bspace(b)
  NEXT b
  SYSTEM
END SUB 'ShowBspace

' END OF FILE


EDIT: It only compiles in Linux if you rename ch and sp (e.g. mych, mysp) due to GAS clashing the (unprefixed ELF?) vars with x86 register names.
Last edited by rugxulo on Aug 26, 2011 22:02, edited 1 time in total.
marcov
Posts: 2751
Joined: Jun 16, 2005 9:45
Location: Eindhoven, NL
Contact:

Postby marcov » Jul 11, 2011 19:33

rugxulo wrote:Here's a minor update with better QB compatibility. (Hence I'm also leaving the old one since it erroneously thinks it's QB compatible when in -lang qb. Note also that -lang qb seems to add 40 kb to the .EXE even though I'm not doing anything specific to it, heh.)


Your first 32-bit program?
rugxulo
Posts: 216
Joined: Jun 30, 2006 5:31
Location: Usono (aka, USA)
Contact:

Postby rugxulo » Jul 11, 2011 19:56

marcov wrote:Your first 32-bit program?


Hmmm? Not exactly, but I'll admit I don't do a lot of heavy programming at the level of Japheth or other gurus.

This is basically just a small piece of befi_3a.zip.
rugxulo
Posts: 216
Joined: Jun 30, 2006 5:31
Location: Usono (aka, USA)
Contact:

Postby rugxulo » Jul 16, 2013 19:02

rugxulo wrote:Here's a minor update ....


Made some more changes recently, compared to last time (including some not explicitly mentioned in source):

  • still technically "qb"-style but using "fblite" for smaller size
  • avoids ch, sp variable names (bad for Linux ELF)
  • fixed accidental numeric literal in fixed string dim and changed literal 10 to EOL
  • now won't crash on bigger than 80x25 (mycology.b98)
  • avoiding use of global one-letter vars
  • fixed accidental omission of reading line no. ymax
  • for QB interpreter's benefit, added reading from %EXAMPLE% if example.bef not found
  • removed slow and (mostly) unnecessary subs ClearStack, ClearBspace
  • commented out some unnecessary debug routines
  • removing SPACE$(xmax-LEN(bspace(z)) as it didn't work: length is always xmax
  • some syntactic shortening ("a = pop : IF a <> 0" becomes "IF pop")


Code: Select all

' $lang: "fblite"  (really only "qb" but this way .EXE saves 45 kb)
'
' Befunge-93 interpreter in QBASIC (1.x), FreeBASIC (0.90.0)
'
' Monday, July 15, 2013
'
'   LICENSE/AUTHOR:
'     = public domain, nenies proprajho, "!! Christus Rex !!"
'     = rugxulo _AT_ gmail _DOT_ com
'   HISTORY:
'     = v1.0 -- semi tested to work fairly well but not fully
'     = v1.1 -- fixed to also compile in lang qb (but not real QB)
'     = v1.2 -- replaced "INPUT ; kk" with "kk = INKEY$"
'     = v1.3 -- fixed to more or less runs in QB and FBC
'     = v1.4 -- renamed ch,sp to avoid Linux BinUtils GAS clash
'     = v1.5 -- now won't crash on bigger than 80x25 (mycology.b98)
'     = v1.6 -- minor cleanups
'     = v1.7 -- now avoids using global one-letter vars
'     = v1.8 -- fixed omission of input line no. ymax (edgetest.bef)
'   BUGS/QUIRKS:
'     = QB needs CR+LF "example.bef" file default (or set %EXAMPLE%)

CONST xmax=80, ymax=25, stackmax=1000, dquote=&H22, EOL=10

TYPE tcoord
  x AS INTEGER
  y AS INTEGER
END TYPE

DIM SHARED coord AS tcoord, delta AS tcoord
DIM SHARED bcode AS INTEGER, strmode AS INTEGER, stkptr AS INTEGER
DIM SHARED bspace(1 TO ymax) AS STRING * xmax
DIM SHARED mystack(1 TO stackmax) AS LONG

'DECLARE SUB B93debug()
'DECLARE SUB ShowBspace()
DECLARE SUB nop()
DECLARE SUB nextup()
DECLARE SUB ReadB93File()
DECLARE SUB interpret()
DECLARE SUB setdelta(xd AS INTEGER, yd AS INTEGER)
DECLARE SUB push(m AS LONG)
'DECLARE SUB wrap(BYREF z AS INTEGER, zmax AS INTEGER) ' -lang fb
DECLARE SUB wrap(z AS INTEGER, zmax AS INTEGER) ' -lang qb
'DECLARE FUNCTION pop() AS LONG ' -lang fb
DECLARE FUNCTION pop&()         ' -lang qb

'===============================================================
REM BEGIN bef93qb

coord.x=-1 : coord.y=0 : setdelta 1,0 : stkptr=stackmax : strmode=0

RANDOMIZE TIMER : ReadB93File

' ShowBspace

DO UNTIL (bcode=ASC("@")) AND (NOT strmode) ' main loop

  nextup
  wrap coord.x,xmax : wrap coord.y,ymax
  bcode=ASC(MID$(bspace(coord.y+1),coord.x+1,1))

' B93debug

  IF (strmode) AND (bcode <> dquote) THEN push INT(bcode)
  IF (bcode=dquote) THEN strmode=NOT strmode
  IF NOT strmode THEN interpret

LOOP ' DO

SYSTEM ' goodbye!

REM END bef93qb
'===============================================================

'SUB B93debug
' DIM d AS INTEGER
'
'  ? " x,y = " + LTRIM$(STR$(coord.x)) + "," + RTRIM$(STR$(y)) ;
'
'  IF (bcode <> dquote) THEN
'    ? " bcode = " + CHR$(dquote) + CHR$(bcode) + CHR$(dquote)
'  ELSE
'    ? " bcode = '" + CHR$(bcode) + "'" ;
'  END IF
'
'  FOR d=1 TO 4
'    IF ((stkptr + d) <= stackmax) THEN ? mystack(stkptr + d) ;
'  NEXT d
'
'  IF (strmode) THEN ? " " + STRING$(4, CHR$(dquote)) ELSE ?
'END SUB 'B93debug

'SUB ShowBspace
' DIM b AS INTEGER
'  FOR b=1 TO ymax
'    ? bspace(b)
'  NEXT b
'  SYSTEM
'END SUB 'ShowBspace

SUB nop
 DIM a AS INTEGER
  a=3*31
END SUB 'nop

SUB nextup
  coord.x=coord.x + delta.x : coord.y=coord.y + delta.y
END SUB 'nextup

SUB setdelta(xd AS INTEGER, yd AS INTEGER)
  delta.x=xd : delta.y=yd
END SUB 'setdelta

'SUB wrap(BYREF z AS INTEGER, zmax AS INTEGER) ' -lang fb
SUB wrap(z AS INTEGER, zmax AS INTEGER) ' -lang qb
  IF (z < 0) THEN
    z=zmax-1
  ELSEIF (z > zmax-1) THEN
    z=0
  END IF
END SUB 'wrap

'FUNCTION pop() AS LONG ' -lang fb
FUNCTION pop&           ' -lang qb
  IF (stkptr < stackmax) THEN
    stkptr=stkptr+1 : pop=mystack(stkptr)
  ELSE
    pop=0
  END IF
END FUNCTION 'pop

SUB push(m AS LONG)
  mystack(stkptr)=m : IF (stkptr > 1) THEN stkptr=stkptr-1
END SUB 'push

SUB ReadB93File
  DIM eg AS INTEGER, f AS INTEGER, z AS INTEGER
  DIM filename AS STRING, zlen AS INTEGER

  eg=FREEFILE : f=1 : filename="example.bef"

' this needs to be commented out for QBASIC 1.x  :-(
' IF COMMAND$(1) <> "" THEN filename=COMMAND$(1) ' -lang fb
  IF ENVIRON$("EXAMPLE") <> "" THEN filename=ENVIRON$("EXAMPLE")

  OPEN filename FOR INPUT AS #eg
  IF ERR > 0 THEN
    ? "ERROR: Couldn't open " + filename : SYSTEM
  END IF

    FOR z=1 TO ymax
      bspace(z)=SPACE$(xmax)
    NEXT z

    DO UNTIL EOF(eg) OR (f > ymax)
      LINE INPUT #eg, bspace(f)
      f=f+1
    LOOP

  CLOSE #eg
END SUB 'ReadB93File

SUB interpret
 DIM a AS LONG, b AS LONG, c AS LONG
 DIM kk AS STRING * 1

  SELECT CASE CHR$(bcode)
  CASE "?":
    SELECT CASE INT(RND * 4)+1
      CASE 1: setdelta 0,-1
      CASE 2: setdelta 0,1
      CASE 3: setdelta -1,0
      CASE 4: setdelta 1,0
    END SELECT
  CASE "0" TO "9": push bcode-ASC("0")
  CASE ".": a=pop : ? LTRIM$(STR$(a)) + " " ;
  CASE ",": a=pop : IF (a=EOL) THEN ? ELSE ? CHR$(a) ;
  CASE "v": setdelta 0,1
  CASE "^": setdelta 0,-1
  CASE "<": setdelta -1,0
  CASE ">": setdelta 1,0
  CASE "#": nextup
  CASE "_": IF pop THEN setdelta -1,0 ELSE setdelta 1,0
  CASE "|": IF pop THEN setdelta 0,-1 ELSE setdelta 0,1
  CASE "`": b=pop : a=pop : IF (a > b) THEN push 1 ELSE push 0
  CASE "!": IF pop=0 THEN push 1 ELSE push 0
  CASE "\": a=pop : b=pop : push a : push b
  CASE ":": a=pop : push a : push a
  CASE "$": a=pop
  CASE "+": b=pop : a=pop : push a + b
  CASE "-": b=pop : a=pop : push a - b
  CASE "*": b=pop : a=pop : push a * b
  CASE "/": b=pop : a=pop : push a \ b ' integer divide
  CASE "%": b=pop : a=pop : push a MOD b
  CASE "~": DO : kk=INKEY$ : LOOP UNTIL kk <> "" : push ASC(kk)
  CASE "&": INPUT a : push a
  CASE "g": b=pop : a=pop : c=ASC(MID$(bspace(b+1),a+1,1)) : push c
  CASE "p": b=pop : a=pop : c=pop : MID$(bspace(b+1),a+1,1)=CHR$(c)
  CASE ELSE: nop
  END SELECT
END SUB 'interpret

REM <EOF>

Return to “DOS”

Who is online

Users browsing this forum: No registered users and 1 guest