FOR x = 0 TO maxheapsize
heaptype[x] = 0
heaptype[x,0] = 0
heaptype[x,1] = 0
heapvalue[x] = 0
heapvalue[x,0] = 0
heapvalue[x,1] = 0
NEXT x
FOR mem = 0 TO MAXHEAPSIZE
HEAPtype[mem,0]=0
HEAPtype[mem,1]=0
HEAPvalue[mem,0]=0
HEAPvalue[mem,1]=0
NEXT mem
DATA{"CONS"}=1
DATA{"CAR"}=2
DATA{"CDR"}=3
FOR p=0 TO UBOUND(DATA) STEP 2
i$ = DATA[p]
primnum = DATA[p+1]
' [0,0]/[0,1] are dummy pair
Primitives[0,0]=""
Primitives[0,1]=0
Primitives[1,0]="CONS"
Primitives[1,1]=1
Primitives[2,0]="CAR"
Primitives[2,1]=2
Primitives[3,0]="CDR"
Primitives[3,1]=3
FOR prm=1 TO MAXPRIM
I=Primitives[prm,0]
PRIMNUM=Primitives[prm,1]
ClearStackLoop:
IF BSD% <> 0 THEN BSD% = BSD% - 1: RETURN ClearStackLoop
GOTO LispReadEvalPrintLoop
ClearStackLoop:
IF bsd<>0 THEN
bsd=bsd-1
REM RETURN ClearStackLoop
RETURN
END IF
GOTO LispReadEvalPrintLoop
ClearStackLoop:
IF BSD<>0 THEN
BSD=BSD-1
GOTO ClearStackLoop
END IF
GOTO LispReadEvalPrintLoop
IF pvalue=38 THEN GOTO DoCos
IF pvalue=38 THEN GOTO DoAtan
IF pvalue=39 THEN GOTO DoGC
IF pvalue=40 THEN GOTO DoEvl
Here's the SB Lisp listing with these bugs fixed and array population corrected. However, it must still be having a few bugs dormant as it fails to do eval correctly (numbers still aren't recognized as type NUMBER/3 but rather type SYMBOL/4 somehow). Nonetheless it's way ahead of your original submission.
P.S. print statements that appear in low case immediately on the left of the listing are my debugging aids and may be safely deleted.
Isn't it cool to see another language built on top of what one already has done with one's own hands?
If I had ever seen a job posting looking for Lisp hackers, I would have been really worried.
I don't think a letter is really necessary. DoLss should be an exact replica of DoGtr (whatever) barring the sign of comparison. I think it can be reconstructed from the existing code.
I left all the former uppercase intact to distinguish it from my deliberate lowercase that I'm adding at debug time. Probably it should stay that way till it starts to function in full.
I'll come back to this code this weekend. It's absolutely terribly, oppressively hot in my whereabouts these days so I'm getting my naps more often than usual. They help me to live on. Will you do me a favor and have a look at your Alaska backyard? You probably forgot to switch off that bloody HAARP oven thing again. :)
Everything seems pleasant HERE (https://weather.yahoo.com/united-states/Washington/Anacortes-2354430/).
The lack of possibility to declare an SB array without assignment is a drawback. "Initialization" of a large (say, 32MB) array in a client-side For/Next loop is extremely time-consuming as compared to Dim a[33554432] which is done on the server side by malloc() or calloc() instantly and without memory fragmentation.
SPLITA STRING(1000001,"0") BY "" TO aThis may be a good palliation in some special cases.
My plan is to extend the Tools extension module to DIM array structures at the C level.This looks like the most reasonable direction to go provided C-compatible array and structure declarations go into the extension together. Think of an array of UDT's with arbitrary member alignment requirements - common practice in C but totally impossible in SB so far.
SPLITA STRING(1000001,"0") BY "" TO a
SPLITA STRING(500001,"0") BY "" TO b
a[0] = b
PRINT UBOUND(a),"\n"
PRINT UBOUND(a[0]),"\n"
PRINT a[0,500000],"\n"
SPLITA STRING(1000001,"0") BY "" TO a
SPLITA STRING(500001,0x0) BY "" TO b
a[0] = b
PRINT UBOUND(a),"\n"
PRINT UBOUND(a[0]),"\n"
PRINT ASC(a[0,500000]),"\n"
PRINT LEN(a[0,500000]),"\n"
SPLITA STRING(1001,"0") BY "" TO a
b[0] = 0
b[1] = 1.23
b[2] = "ABC"
FOR x = 0 to 1000
a[x] = b
NEXT
PRINT UBOUND(a),"\n"
PRINT UBOUND(a[500]),"\n"
PRINT a[10,0],"\n"
PRINT FORMAT("%g",a[100,1]),"\n"
PRINT a[1000,2],"\n"
BTW what will be the timing to split a string of 1Mln+1 bytes? This last benchmark doesn't correlate well with the preceding ones.
b[0] = 0
b[1] = 1.23
b[2] = "ABC"
FOR x = 0 to 1000
a[x] = b
NEXT
PRINT UBOUND(a),"\n"
PRINT UBOUND(a[500]),"\n"
PRINT a[10,0],"\n"
PRINT FORMAT("%g",a[100,1]),"\n"
PRINT a[1000,2],"\n"
I've fixed one more problem in Lisp print (QB45's Str$() has weird formatting for non-negative numbers), and I've also added DoLss (it was indeed a matter of changing > to <). I haven't found anything else of interest yet. But I think I've seen a recursive GoSub somewhere and I think this may cause all sorts of headaches for SB. I lost the exact spot however and can't find it again easily 'cause of all this medieval bloat in the original code.
4. I'm doing a quick port to FBSL now to see if it would work there.
We're not dealing with true SB recursion here as these are not true functions. These are just recursive pieces of QB45 code which have their own scope (remember the "p" bug?). I strongly doubt Peter would go that far in his implementation of this ancient BASIC functionality. I certainly didn't. Neither did Charles, to the best of my knowledge. thinBasic doesn't have all this GoTo/GoSub mess at all.
. QB45's NOT FALSE evaluates to -1. You can check it with PRINT. QB45 doesn't define the FALSE and TRUE constants internally.
3. The only other place where INT() is used is not correct either. Lisp requires explicit Floor() in its DoFloor portion which is not the same as BASIC's INT(). It should round its positive argument down to the closest lower integer but it should round its negative argument to the closest upper integer. QB45's INT() works like a Round() function which rounds its argument arithmetically to the nearest absolute value with a corresponding sign. This isn't correct for a Floor() call.
IIRC FIX() is simple truncation. Please correct me if I'm mistaken.
Here comes FBSL Lisp.
That means SB FIX() works like true Floor() - so we'll be using it in DoFloor instead of INT().
Now, what are we going to do with all this LISP?
Let's ask Aurel - it's his thread, after all
well yes i started this thread ..i don't know why
.....what ?
selbstverschtendlich
"Wat" means "was" (germ.) in the Berliner and Westfälischer dialects?
IF INSTR("()'",CURCHAR) OR CURCHAR<=" " THEN
IF INSTR("()'",CURCHAR)<>0 OR CURCHAR<=" " THEN
This function can be used to search a sub-string in a string. The first argument is the string we are searching in. The second argument is the string that we actually want to find in the first argument. The third optional argument is the position where the search is to be started. If this argu-ment is missing the search starts with the first character position of the string. The function returns the position where the sub-string can be found in the first string. If the searched sub-string is not found in the string then the return value is undef.
p = 0
p = INSTR("ABC","Z")
PRINT p,"\n"
Aurel,
naturlich und selbstverschtendlich = wrong
Natürlich und Selbstverständlich = correct
QuoteAurel,
naturlich und selbstverschtendlich = wrong
Natürlich und Selbstverständlich = correct
yes Peter i know ,i don't have german keyboard :-\
IF PTYPE<>NUMBER OR QTYPE<>NUMBER THEN
PRINT "ERROR:IN >"
GOTO HandleError
END IF
IF PVALUENUMBER OR QTYPE<>NUMBER THEN
PRINT "ERROR:IN <"
GOTO HandleError
END IF
Am I correct saying this, Peter?
(defun fact (n)
(if (< n 2)
1
(* n (fact(- n 1)))))
Notice: "An meinen Freunden Aurel und Mike" is incorrect, "An mein Freund Aurel und Mike" is correct
(defun fact (n)
(if (< n 2)
1
(* n (fact(- n 1)))))
( let n 5 )
( * n ( iter n ) ) ; expands to ( * 5 4 3 2 1 )
IMHO .. an meinem Freund then , it must be "Dativ" , not ??I guess that's the question for Peter, not for me. ;)
Is there a list with functions and macro's of this Lisp -- the pdf gives some examples, but I'm not sure what's inside.Unfortunately, the PDF is all we have. Its list of features is exhaustive for this implementation. Thanks for your code snippets anyway but they don't seem to go well with this implementation due to the lack of features.
I tried to run the (what was it ) something with pc.exe - but it does not work with my keyboard .Not sure exactly what you mean but if you want to run this Lisp as an executable under Windows, you can use its FBSL adaptation (http://www.oxygenbasic.org/forum/index.php?topic=1147.msg10076#msg10076). It wasn't optimized for speed and carried a lot of unnecessary rubbish like if asc("a") < asc("b") in place of if "a" < "b" just to be on the safe side while debugging, but it will work.
gross (short o) grosz (long o) -- not sure Gross exists in German , normally it should mean a dozen of dozens (12x12)Yes, understood. I was just talking about the absence of a German keyboard layout (have a look at a QWERTY keyboard (http://www.microsoft.com/enable/images/products/kbqwerty.gif)), in which case the typist is supposed to substitute a "beta" glyph with a double "s" -> "ss". At least this is what my wife's telling me. She's a Belarusian but she grew up in East Berlin and she also used to be a certified typist in her greener years.
the big gun attached (I had to post twice previously ..)Yes, I got the SZ written there. BTW that one wasn't of the largest caliber actually. Царь-пушка (The Tzar Gun) in the Moscow Kremlin seems to be somewhat more impressive. :)
John and I would appreciate it if you could do it for us.
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](defun fact (n)
1] (if (< n 2)
2] 1
2] (* n (fact(- n 1)))))
ERROR: UNBOUND VARIABLE
0]
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](define factorial (lambda (n)
2] (if ((= n 0)
4] 1
4] (* n (fractorial (- n 1)))))))
FACTORIAL
0](factorial 8)
ERROR: BAD TYPE IN CAR
0]
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](define factorial (lambda (n)
2](if (< n 0)
3]1
3](* n (fractorial (- n 1)))))))
FACTORIAL
0](factorial 8)
ERROR: IN <
0]
(define factorial (lambda (n)
(if (<= n 0)
1
(* n (factorial (- n 1)))))))
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](define factorial (lambda (n)
2](if (<= n 0)
3]1
3](* n (factorial (- n 1)))))))
FACTORIAL
0](factorial 8)
40320
0]
My sincere congratulations again.
( let average "
( /
( +
(next)
item
)
(count)
)
")
( average 1 2 3 4 5 ) ; 3
I could have but I am very, very careful not to sleep in my bed with a cigarette.
Rob, I will try to get an updated Lispish version out tonight - adding in some more maths functions.
"Be what you would seem to be - or, if you'd like it put more simply - never imagine yourself not to be otherwise than what it might appear to others that what you were or might have been was not otherwise than what you had been would have appeared to them to be otherwise.”
Seems Aurel is on the war path again.no..no...i am not...
No Aurel
QuoteNo AurelNo Mike
You are not JRS...you are not LIAR
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](define factorial (lambda (n)
2](if (<= n 0)
3]1
3](* n (factorial (- n 1)))))))
FACTORIAL
0](factorial 8)
40320
0](quit)
Bye!
jrs@laptop:~/sb/sb22/sblisp$
DoFlr:
ptype = qtype
pvalue = qvalue
bsd += 1
GOSUB Car
IF rtype = number THEN
rvalue = INT(rvalue)
bsd -= 1
RETURN
END IF
PRINT "ERROR: In FLOOR\n"
GOTO HandleError
What Common Lisp has got: What Scheme has got:
Much better developed standard SLIB + SRFI's + a hundred little
libraries libs that each do things differently
and aren't very standardized.
(Arguably Scheme is the place where new ideas fight for mindshare
and prove themselves - but the fights and the multiplicity
of contenders commits most code to one idea or another and
limits the code's interoperability, longevity, and/or
portability.)
A well-defined comprehensive A well-defined minimal spec plus
spec and several implementations dozens of variously comprehensive
which provide some extensions. implementations.
Escaping continuations only. Fully reentrant continuations.
Scheme just wins on this point.
(I have heard the arguments about whether fully reentrant
continuations are worth the cost of stack copying, or the
cost of heap-allocating and garbage collecting invocation
frames. I don't care. I'm just noting here that you can
do a *LOT* of things with them that are hard to do without
them.)
Lots of iterative constructs Memory-safe tail recursion avoids
the need for iteration syntax.
There's a looping construct, but
it's more complicated than tail
recursion so hardly anyone uses it.
If you care for them, you can
roll your own using continuations.
Both Lexically and Dynamically Lexical scope only, per the standard.
scoped special vars. Common Dynamically scoped vars are provided
Lisp just wins on this point. by some implementations as an extension
but code using them is not portable.
(I have heard the arguments about whether Dynamic scoping
is or is not a Bad Idea in the first place. I don't care.
I'm just noting that you can do things with it that you
can't easily do without it.)
C numeric types plus bignums Implementation-defined numeric types,
and complex nums, but no exact/ in some implementations failing to
inexact distinction. include bignums or complex nums. An
exact/inexact distinction is required
by the standard but properly implemented
in only about 3/4 of scheme systems.
In a good implementation, numerics
(capabilities and correctness) are
better than most CLs; on average,
they are worse.
Optional type declarations Optional type declarations provided
allow blazing fast numeric by a few implementations as extensions.
code to skip typechecking. Code using them is nonportable. Some
Common Lisp just wins on numeric implementations provide blazing speed
calculation speed. but generally at the expense of numeric
type richness and/or standard
conformance.
Signals and conditions, catch Roll your own using fully reentrant
and throw. continuations, or use any of several
libraries.
CLOS Roll your own objects using closures
and macros, or any of several OO
libraries. TinyCLOS and Meroon are
the most popular.
Well-defined standard module At least three competing well-defined
system. Common Lisp just wins module systems which it's a pain in
on this point. the butt to move modules between.
(or roll your own using scope, macros,
and/or preprocessing code).
Readtables for low-level Implementation-defined means of doing
macrology. Common Lisp wins low-level macrology - none of it
here. portable.
gensym tricks to avoid implicit hygienic macros with define-syntax and
variable captures in high-level syntax-case. You *can't* capture a
macros. variable in a macro except explicitly.
(Different people claim this as a "win" for both languages.
I don't care. There is little difference in what I can do
with it, nor in how hard it is to do it, so I'm not the guy
to judge a winner here.)
One-argument eval assumes environment specifier is second arg to
environment eval, allowing access to multiple
environments. Scheme just wins here.
Lambda syntax supports keyword Available as add-on library developed
arguments & default vals for using macros, but widely ignored.
optional arguments.
Symbols have properties, Variables have values and also names.
including but not limited to The names are lexically indistinguishable
function value and data value. from symbols but the value of a variable
is not a property of its name symbol.
Property lists are an extension
provided by relatively few schemes.
Native hash tables. Library hash tables.
Well-defined means of doing A fragile hack that depends on common
binary I/O. Common Lisp just character encodings and/or assumption
wins here. that character ports act as byte ports.
Assertions. Common Lisp just In scheme you have to do this as two
wins here. macros; one for development, that signals
an error if the condition isn't true, and
one for production code which "expands"
into nothing and gets out of the way.
The compiler will not use your assertions
to produce better code.
Large runtime environment Small runtime environment, easily
embeddable. Scheme wins here.
jrs@laptop:~$ mit-scheme
MIT/GNU Scheme running under GNU/Linux
Type `^C' (control-C) followed by `H' to obtain information about interrupts.
Copyright (C) 2014 Massachusetts Institute of Technology
This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
Image saved on Saturday May 17, 2014 at 2:39:25 AM
Release 9.2 || Microcode 15.3 || Runtime 15.7 || SF 4.41 || LIAR/x86-64 4.118 || Edwin 3.116
1 ]=> (define factorial (lambda (n)
(if (<= n 0)
1
(* n (factorial (- n 1)))))))
;Value: factorial
1 ]=> (factorial 8)
;Value: 40320
1 ]=> (quit)
[1]+ Stopped mit-scheme
jrs@laptop:~$
. Is the table your own investigation or someone else's?
(define factorial (lambda (n)
(if (<= n 0)
1
(* n (factorial (- n 1)))))))
(factorial 8)
-- do not use (load "fact.lisp") - this isn't a proper syntax for Lisp. You should use (load (quote fact.lisp)) instead.IF NOT EOF(LispFileNum) THEN
LINE INPUT# LispFileNum, I
I = CHOMP(I)
PRINT I, "\n"
IPOS = 1
END IF
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load (quote factfunc.scm))
FACTFUNC.SCM 1
(0): error &H16:The file can not be opened.
jrs@laptop:~/sb/sb22/sblisp$
... as it was parsing the load command, the resulting string was upper cased and escaped with \" characters.
Yep. I'm going to have to deal with the UPPER case issue on Linux.
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load (quote FF.SCM)
1]
ERROR: Read.
0]
(define factorial (lambda (n)
(if (<= n 0)
1
(* n (factorial (- n 1))))))
(factorial 8)
Not bad source at all. LISP is simple, but I still wouldn't know how to implement it in QBASIC
jrs@laptop:~/sb/sb22/sblisp$ mit-scheme
MIT/GNU Scheme running under GNU/Linux
Type `^C' (control-C) followed by `H' to obtain information about interrupts.
Copyright (C) 2014 Massachusetts Institute of Technology
This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
Image saved on Saturday May 17, 2014 at 2:39:25 AM
Release 9.2 || Microcode 15.3 || Runtime 15.7 || SF 4.41 || LIAR/x86-64 4.118 || Edwin 3.116
1 ]=> (load (quote FF.SCM))
;The object ff.scm, passed as an argument to merge-pathnames, is not a pathname.
;To continue, call RESTART with an option number:
; (RESTART 1) => Return to read-eval-print level 1.
2 error>
For now, ALL loaded SBLisp scripts must have the filename in UPPER CASE.Well, this is much more restrictive than the palliation that I suggested. Now SBLisp and "the gold standard" are worthy of one another - both are dumb as hell.
Wasn't that easy? ;D
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sbWait wait, but where's the closing parenthesis, may I ask?
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load (quote FF.SCM)
1]
ERROR: Read.
0]
GetLine:John, you're downright ignoring my messages (http://www.oxygenbasic.org/forum/index.php?topic=1147.msg10191#msg10191):
IF lispfilenum = 0 THEN
PRINT LTRIM(FORMAT("%~##~", oparen)), "]"
LINE INPUT ibuf
ibuf = CHOMP(ibuf)
ipos = 1
ELSE
IF NOT EOF(lispfilenum) THEN
LINE INPUT# lispfilenum, ibuf
PRINT ibuf
ipos = 1
END IF
END IF
bsd -= 1
RETURN
IF NOT EOF(LispFileNum) THEN
LINE INPUT# LispFileNum, I
I = CHOMP(I)
PRINT I, "\n"
IPOS = 1
END IF
Please correct the Bitbucket sources and get your linuxoid SBLisp up and running at last. ;)Well, at least we got by the SB OPEN.Not "we" but "I". As for me, I got the Windows scriba.exe+lisp.sb reading and executing LISP files 48 hours ago. :)
Not "we" but "I". As for me, I got the Windows scriba.exe+lisp.sb reading and executing LISP files 48 hours ago.
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load (quote FF.SCM))
FF.SCM 1
(define factorial (lambda (n)
(if (<= n 0)
1
(* n (factorial (- n 1))))))
FACTORIAL
(factorial 8)
40320
ERROR: Read.
ERROR: Problem in file FF.SCM
0]
(define factorial (lambda (n)
(if (<= n 0)
1
(* n (factorial (- n 1))))))
(factorial 8)
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load (quote FF.SCM))
FF.SCM 1
(define factorial (lambda (n)
(if (<= n 0)
1
(* n (factorial (- n 1))))))
FACTORIAL
(factorial 8)
40320
ERROR: Problem in file FF.SCM
0]
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load (quote FF.SCM))
FF.SCM 1
(define factorial (lambda (n)
(if (<= n 0)
1
(* n (factorial (- n 1))))))
FACTORIAL
(factorial 8)
40320
T
0]
(load (quote test.lisp))
(load 'test.lisp)
(print '_)
(define rectest (lambda (x)
(cond ((<= x (* 1000)) (print x) (print '_) (rectest (+ x 1))))
))
(rectest 1)
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load (quote RECTEST.LISP))
RECTEST.LISP 1
(define rectest (lambda (x)
(cond ((<= x (* 1000)) (print x) (print '_) (rectest (+ x 1))))
))
RECTEST
(rectest 1)
1_2_3_4_5_6_7_8_9_10_11_12_13_14_15_16_17_18_19_20_21_22_23_24_25_26_27_28_29_30_31_32_33_34_35_36_37_38_39_40_41_42_43_44_45_46_47_48_49_50_51_52_53_54_55_56_57_58_59_60_61_62_63_64_65_66_67_68_69_70_71_72_73_74_75_76_77_78_79_80_81_82_83_84_85_86_87_88_89_90_91_92_93_94_95_96_97_98_99_100_101_102_103_104_105_106_107_108_109_110_111_112_113_114_115_116_117_118_119_120_121_122_123_124_125_126_127_128_129_130_131_132_133_134_135_136_137_138_139_140_141_142_143_144_145_146_147_148_149_150_151_152_153_154_155_156_157_158_159_160_161_162_163_164_165_166_167_168_169_GC START GC done.
170_171_172_173_174_175_176_177_178_179_180_181_182_183_184_185_186_187_188_189_190_191_192_193_194_195_196_197_198_199_200_201_202_203_204_205_206_207_208_209_210_211_212_213_214_215_216_217_218_219_220_221_222_223_224_225_226_227_228_229_230_231_232_233_234_235_236_237_238_239_240_241_242_243_244_245_246_247_248_249_250_251_252_253_254_255_256_257_258_259_260_261_262_263_264_265_266_267_268_269_270_271_272_273_274_275_276_277_278_279_280_281_282_283_284_285_286_287_288_289_290_291_292_293_294_295_296_297_298_299_300_301_302_303_304_305_306_307_308_309_310_311_312_313_314_315_316_317_318_319_320_321_322_323_324_325_326_327_328_329_330_331_332_333_334_335_336_337_338_339_GC START GC done.
340_341_342_343_344_345_346_347_348_349_350_351_352_353_354_355_356_357_358_359_360_361_362_363_364_365_366_367_368_369_370_371_372_373_374_375_376_377_378_379_380_381_382_383_384_385_386_387_388_389_390_391_392_393_394_395_396_397_398_399_400_401_402_403_404_405_406_407_408_409_410_411_412_413_414_415_416_417_418_419_420_421_422_423_424_425_426_427_428_429_430_431_432_433_434_435_436_437_438_439_440_441_442_443_444_445_446_447_448_449_450_451_452_453_454_455_456_457_458_459_460_461_462_463_464_465_466_467_468_469_470_471_472_473_474_475_476_477_478_479_480_481_482_483_484_485_486_487_488_489_490_491_492_493_494_495_496_497_498_499_500_501_502_503_504_505_506_507_508_509_GC START GC done.
510_511_512_513_514_515_516_517_518_519_520_521_522_523_524_525_526_527_528_529_530_531_532_533_534_535_536_537_538_539_540_541_542_543_544_545_546_547_548_549_550_551_552_553_554_555_556_557_558_559_560_561_562_563_564_565_566_567_568_569_570_571_572_573_574_575_576_577_578_579_580_581_582_583_584_585_586_587_588_589_590_591_592_593_594_595_596_597_598_599_600_601_602_603_604_605_606_607_608_609_610_611_612_613_614_615_616_617_618_619_620_621_622_623_624_625_626_627_628_629_630_631_632_633_634_635_636_637_638_639_640_641_642_643_644_645_646_647_648_649_650_651_652_653_654_655_656_657_658_659_660_661_662_663_664_665_666_667_668_669_670_671_672_673_674_675_676_677_678_679_GC START GC done.
680_681_682_683_684_685_686_687_688_689_690_691_692_693_694_695_696_697_698_699_700_701_702_703_704_705_706_707_708_709_710_711_712_713_714_715_716_717_718_719_720_721_722_723_724_725_726_727_728_729_730_731_732_733_734_735_736_737_738_739_740_741_742_743_744_745_746_747_748_749_750_751_752_753_754_755_756_757_758_759_760_761_762_763_764_765_766_767_768_769_770_771_772_773_774_775_776_777_778_779_780_781_782_783_784_785_786_787_788_789_790_791_792_793_794_795_796_797_798_799_800_801_802_803_804_805_806_807_808_809_810_811_812_813_814_815_816_817_818_819_820_821_822_823_824_825_826_827_828_829_830_831_832_833_834_835_836_837_838_839_840_841_842_843_844_845_846_847_848_849_GC START GC done.
850_851_852_853_854_855_856_857_858_859_860_861_862_863_864_865_866_867_868_869_870_871_872_873_874_875_876_877_878_879_880_881_882_883_884_885_886_887_888_889_890_891_892_893_894_895_896_897_898_899_900_901_902_903_904_905_906_907_908_909_910_911_912_913_914_915_916_917_918_919_920_921_922_923_924_925_926_927_928_929_930_931_932_933_934_935_936_937_938_939_940_941_942_943_944_945_946_947_948_949_950_951_952_953_954_955_956_957_958_959_960_961_962_963_964_965_966_967_968_969_970_971_972_973_974_975_976_977_978_979_980_981_982_983_984_985_986_987_988_989_990_991_992_993_994_995_996_997_998_999_1000_()
T
0]
(define rectest (lambda (x)
(cond ((<= x (* 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000)) (rectest (+ x 1))))
))
(rectest 1)
1000*1000*1000*1000*1000*1000*1000*1000*1000*1000
rectest 1
sub rectest (x)
if x <= 1000*1000*1000*1000*1000*1000*1000*1000*1000*1000 then
rectest x+1
end if
end sub
:DoBgr
CTYPE=QTYPE
CVALUE=QVALUE
PTYPE=CTYPE
PVALUE=CVALUE
BSD=BSD+1
GOSUB Cdr
BSD=BSD+1
GOSUB RregtoPreg
BSD=BSD+1
GOSUB Car
BSD=BSD+1
GOSUB RregtoQreg
PTYPE=CTYPE
PVALUE=CVALUE
BSD=BSD+1
GOSUB Car
BSD=BSD+1
GOSUB RregtoPreg
IF PTYPE<>NUMBER OR QTYPE<>NUMBER THEN
PRINT "ERROR: IN >\n"
GOTO HandleError
END IF
'IF PVALUE<>NUMBER OR QTYPE<>NUMBER THEN
' PRINT "ERROR: IN >\n"
' GOTO HandleError
'END IF
IF PVALUE<QVALUE THEN
RTYPE=BOOLEANT
RVALUE=TRUE
BSD=BSD-1
RETURN
END IF
RTYPE=NULL
RVALUE=FALSE
BSD=BSD-1
RETURN
:DoLss
CTYPE=QTYPE
CVALUE=QVALUE
PTYPE=CTYPE
PVALUE=CVALUE
BSD=BSD+1
GOSUB Cdr
BSD=BSD+1
GOSUB RregtoPreg
BSD=BSD+1
GOSUB Car
BSD=BSD+1
GOSUB RregtoQreg
PTYPE=CTYPE
PVALUE=CVALUE
BSD=BSD+1
GOSUB Car
BSD=BSD+1
GOSUB RregtoPreg
IF PTYPE<>NUMBER OR QTYPE<>NUMBER THEN
PRINT "ERROR: IN <\n"
GOTO HandleError
END IF
'IF PVALUE<>NUMBER OR QTYPE<>NUMBER THEN
' PRINT "ERROR: IN <\n"
' GOTO HandleError
'END IF
IF PVALUE>QVALUE THEN
RTYPE=BOOLEANT
RVALUE=TRUE
BSD=BSD-1
RETURN
END IF
RTYPE=NULL
RVALUE=FALSE
BSD=BSD-1
RETURN
maxlevel 29666
(print 'A) (newline) (print 'B) (newline)
Sure glad you're steering this boat.
(define accum 0)
(define average
(lambda (input)
(for-each (lambda (x) (set! accum (+ accum x))) input)
(print (set! accum (/ accum (length input)))) (newline)
)
)
(define args (list 1 2 3 4 5))
(average args)
(define accum 0)
(define average
(lambda (input)
(for-each (lambda (x) (set! accum (+ accum x))) input)
(print (set! accum (/ accum (length input)))) (newline)
)
)
(average (list 0 1 2 3 4 5 6 7 8 9))
(define average
(lambda (input)
(let ((accum 0))
(for-each (lambda (x) (set! accum (+ accum x))) input)
(print (/ accum (length input))) (newline)
)
)
)
(average (list 0 1 2 3 4 5 6 7 8 9))
(define foo
(lambda (bar)
...
)
)
declare function foo (bar)
...
end function
(lambda (bar) ... )
(define average
(lambda (input)
...
)
)
(lambda (x) ... )
(define average
(lambda (input)
(print (/ (apply + input) (length input))) (newline)
)
)
(average (list 0 1 2 3 4 5 6 7 8 9))
or you can also read and/or download it directly from the author's.
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load 'AVE.SCM)
AVE.SCM 1
(define average
(lambda (input)
(print (/ (apply + input) (length input))) (newline)
)
)
AVERAGE
(average (list 0 1 2 3 4 5 6 7 8 9))
4.500000
T
T
0]
lispfilename = symbols[pvalue]
OPTION COMPARE sbCaseInsensitive
fnpos = INSTR(ibuf, lispfilename)
IF fnpos THEN lispfilename = MID(ibuf, fnpos, LEN(lispfilename))
OPTION COMPARE sbCaseSensitive
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load 'Ave.scm)
Ave.scm 1
(define average
(lambda (input)
(print (/ (apply + input) (length input))) (newline)
)
)
AVERAGE
(average (list 0 1 2 3 4 5 6 7 8 9))
4.500000
T
T
0]
IF ipos > LEN(ibuf) THEN
' PRINT "ERROR: Read.\n"
' GOTO HandleError
GOTO GetLine
END IF
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load 'Ave.scm)
Ave.scm 1
(define average
(lambda (input)
(print (/ (apply + input) (length input))) (newline)
)
)
AVERAGE
(average (list 0 1 2 3 4 5 6 7 8 9))
4.500000
T
T
0](quit)
Bye!
jrs@laptop:~/sb/sb22/sblisp$
CheckDot:
ipos+=1
IF ipos > LEN(ibuf) THEN
' PRINT "ERROR: Read.\n"
' GOTO HandleError
GOTO GetLine
END IF
...
HandleError:
IF lispfilenum <> 0 THEN
' PRINT "ERROR: Problem in file ", lispfilename, "\n"
' The original author of this code is Arthur Nunes-Harwitt
cmdln = COMMAND()
IF LEN(cmdln) THEN
cmdflg = TRUE
ELSE
cmdflg = FALSE
END IF
...
GetLine:
IF cmdflg THEN
ibuf = "(load '" & cmdln & ")"
ipos = 1
cmdflg = FALSE
bsd -=1
RETURN
END IF
jrs@laptop:~/sb/sb22/sblisp$ time scriba lisp.sb Ave.scm
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
(define average
(lambda (input)
(print (/ (apply + input) (length input))) (newline)
)
)
AVERAGE
(average (list 0 1 2 3 4 5 6 7 8 9))
4.500000
T
(quit)
Bye!
real 0m0.240s
user 0m0.232s
sys 0m0.008s
jrs@laptop:~/sb/sb22/sblisp$
jrs@laptop:~/sb/sb22/sblisp$ time scriba lisp.sb rectest.scm
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
(define rectest (lambda (x)
(cond ((<= x (* 1000)) (print x) (print '_) (rectest (+ x 1))))
))
RECTEST
(rectest 1)
1_2_3_4_5_6_7_8_9_10_11_12_13_14_15_16_17_18_19_20_21_22_23_24_25_26_27_28_29_30_31_32_33_34_35_36_37_38_39_40_41_42_43_44_45_46_47_48_49_50_51_52_53_54_55_56_57_58_59_60_61_62_63_64_65_66_67_68_69_70_71_72_73_74_75_76_77_78_79_80_81_82_83_84_85_86_87_88_89_90_91_92_93_94_95_96_97_98_99_100_101_102_103_104_105_106_107_108_109_110_111_112_113_114_115_116_117_118_119_120_121_122_123_124_125_126_127_128_129_130_131_132_133_134_135_136_137_138_139_140_141_142_143_144_145_146_147_148_149_150_151_152_153_154_155_156_157_158_159_160_161_162_163_164_165_166_167_168_169_GC start GC done.
170_171_172_173_174_175_176_177_178_179_180_181_182_183_184_185_186_187_188_189_190_191_192_193_194_195_196_197_198_199_200_201_202_203_204_205_206_207_208_209_210_211_212_213_214_215_216_217_218_219_220_221_222_223_224_225_226_227_228_229_230_231_232_233_234_235_236_237_238_239_240_241_242_243_244_245_246_247_248_249_250_251_252_253_254_255_256_257_258_259_260_261_262_263_264_265_266_267_268_269_270_271_272_273_274_275_276_277_278_279_280_281_282_283_284_285_286_287_288_289_290_291_292_293_294_295_296_297_298_299_300_301_302_303_304_305_306_307_308_309_310_311_312_313_314_315_316_317_318_319_320_321_322_323_324_325_326_327_328_329_330_331_332_333_334_335_336_337_338_339_GC start GC done.
340_341_342_343_344_345_346_347_348_349_350_351_352_353_354_355_356_357_358_359_360_361_362_363_364_365_366_367_368_369_370_371_372_373_374_375_376_377_378_379_380_381_382_383_384_385_386_387_388_389_390_391_392_393_394_395_396_397_398_399_400_401_402_403_404_405_406_407_408_409_410_411_412_413_414_415_416_417_418_419_420_421_422_423_424_425_426_427_428_429_430_431_432_433_434_435_436_437_438_439_440_441_442_443_444_445_446_447_448_449_450_451_452_453_454_455_456_457_458_459_460_461_462_463_464_465_466_467_468_469_470_471_472_473_474_475_476_477_478_479_480_481_482_483_484_485_486_487_488_489_490_491_492_493_494_495_496_497_498_499_500_501_502_503_504_505_506_507_508_509_GC start GC done.
510_511_512_513_514_515_516_517_518_519_520_521_522_523_524_525_526_527_528_529_530_531_532_533_534_535_536_537_538_539_540_541_542_543_544_545_546_547_548_549_550_551_552_553_554_555_556_557_558_559_560_561_562_563_564_565_566_567_568_569_570_571_572_573_574_575_576_577_578_579_580_581_582_583_584_585_586_587_588_589_590_591_592_593_594_595_596_597_598_599_600_601_602_603_604_605_606_607_608_609_610_611_612_613_614_615_616_617_618_619_620_621_622_623_624_625_626_627_628_629_630_631_632_633_634_635_636_637_638_639_640_641_642_643_644_645_646_647_648_649_650_651_652_653_654_655_656_657_658_659_660_661_662_663_664_665_666_667_668_669_670_671_672_673_674_675_676_677_678_679_GC start GC done.
680_681_682_683_684_685_686_687_688_689_690_691_692_693_694_695_696_697_698_699_700_701_702_703_704_705_706_707_708_709_710_711_712_713_714_715_716_717_718_719_720_721_722_723_724_725_726_727_728_729_730_731_732_733_734_735_736_737_738_739_740_741_742_743_744_745_746_747_748_749_750_751_752_753_754_755_756_757_758_759_760_761_762_763_764_765_766_767_768_769_770_771_772_773_774_775_776_777_778_779_780_781_782_783_784_785_786_787_788_789_790_791_792_793_794_795_796_797_798_799_800_801_802_803_804_805_806_807_808_809_810_811_812_813_814_815_816_817_818_819_820_821_822_823_824_825_826_827_828_829_830_831_832_833_834_835_836_837_838_839_840_841_842_843_844_845_846_847_848_849_GC start GC done.
850_851_852_853_854_855_856_857_858_859_860_861_862_863_864_865_866_867_868_869_870_871_872_873_874_875_876_877_878_879_880_881_882_883_884_885_886_887_888_889_890_891_892_893_894_895_896_897_898_899_900_901_902_903_904_905_906_907_908_909_910_911_912_913_914_915_916_917_918_919_920_921_922_923_924_925_926_927_928_929_930_931_932_933_934_935_936_937_938_939_940_941_942_943_944_945_946_947_948_949_950_951_952_953_954_955_956_957_958_959_960_961_962_963_964_965_966_967_968_969_970_971_972_973_974_975_976_977_978_979_980_981_982_983_984_985_986_987_988_989_990_991_992_993_994_995_996_997_998_999_1000_()
(quit)
Bye!
real 0m1.441s
user 0m1.428s
sys 0m0.008s
jrs@laptop:~/sb/sb22/sblisp$
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](let ((x 5)) (+ x 1))
6
0](+ '5 '6)
11
0](/ 12 2 3)
0.666667
0]
jrs@laptop:~/sb/sb22/sblisp$ mit-scheme
MIT/GNU Scheme running under GNU/Linux
Type `^C' (control-C) followed by `H' to obtain information about interrupts.
Copyright (C) 2014 Massachusetts Institute of Technology
This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
Image saved on Saturday May 17, 2014 at 2:39:25 AM
Release 9.2 || Microcode 15.3 || Runtime 15.7 || SF 4.41 || LIAR/x86-64 4.118 || Edwin 3.116
1 ]=> (/ 12 2 3)
;Value: 2
1 ]=>
GetLine:
IF LispFileNum=0 THEN
PRINT LTRIM(FORMAT("%~##~",OPAREN)), "]"
LINE INPUT I
I = CHOMP(I)
IF ASC(I) = undef THEN GOTO GetLine
IPOS = 1
ELSE
IF NOT EOF(LispFileNum) THEN
LINE INPUT# LispFileNum, I
I = CHOMP(I)
IF ASC(I) = undef THEN GOTO GetLine
PRINT I, "\n"
IPOS = 1
ELSE
GOTO LispCloseFile
END IF
END IF
BSD=BSD-1
RETURN
Will you please undo your repo sources of SBLisp so that I could use them for my future submissions here?
jrs@laptop:~$ cd sb/sb22/sblisp
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load 'Ave.scm)
(define average
(lambda (input)
(print (/ (apply + input) (length input))) (newline)
)
)
AVERAGE
(average (list 0 1 2 3 4 5 6 7 8 9))
4.500000
T
0]
0](quit)
Bye!
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
0](load 'Ave.scm)
(define average
(lambda (input)
(print (/ (apply + input) (length input))) (newline)
)
)
AVERAGE
(average (list 0 1 2 3 4 5 6 7 8 9))
4.500000
T
0](quit)
Bye!
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb Ave.scm
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
(define average
(lambda (input)
(print (/ (apply + input) (length input))) (newline)
)
)
AVERAGE
(average (list 0 1 2 3 4 5 6 7 8 9))
4.500000
T
(quit)
Bye!
jrs@laptop:~/sb/sb22/sblisp$
HandleInternalError:
IF ERROR() = &H14 THEN
' Re-enable error trapping
ON ERROR GOTO HandleInternalError
' Resume at next line
RESUME NEXT
END IF
' Resume at same line
RESUME
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb Ave.scm
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
(define average
(lambda (input)
(print (/ (apply + input) (length input))) (newline)
)
)
AVERAGE
(average (list 0 1 2 3 4 5 6 7 8 9))
4.500000
T
0](load 'rectest.scm)
(define rectest (lambda (x)
(cond ((<= x (* 1000)) (print x) (print '_) (rectest (+ x 1))))
))
RECTEST
(rectest 1)
1_2_3_4_5_6_7_8_9_10_11_12_13_14_15_16_17_18_19_20_21_22_23_24_25_26_27_28_29_30_31_32_33_34_35_36_37_38_39_40_41_42_43_44_45_46_47_48_49_50_51_52_53_54_55_56_57_58_59_60_61_62_63_64_65_66_67_68_69_70_71_72_73_74_75_76_77_78_79_80_81_82_83_84_85_86_87_88_89_90_91_92_93_94_95_96_97_98_99_100_101_102_103_104_105_106_107_108_109_110_111_112_113_114_115_116_117_118_119_120_121_122_123_124_125_126_127_128_129_130_131_132_133_134_135_136_137_138_139_140_141_142_143_144_145_146_147_148_149_150_151_152_153_154_155_156_157_158_159_160_161_162_GC start GC done.
163_164_165_166_167_168_169_170_171_172_173_174_175_176_177_178_179_180_181_182_183_184_185_186_187_188_189_190_191_192_193_194_195_196_197_198_199_200_201_202_203_204_205_206_207_208_209_210_211_212_213_214_215_216_217_218_219_220_221_222_223_224_225_226_227_228_229_230_231_232_233_234_235_236_237_238_239_240_241_242_243_244_245_246_247_248_249_250_251_252_253_254_255_256_257_258_259_260_261_262_263_264_265_266_267_268_269_270_271_272_273_274_275_276_277_278_279_280_281_282_283_284_285_286_287_288_289_290_291_292_293_294_295_296_297_298_299_300_301_302_303_304_305_306_307_308_309_310_311_312_313_314_315_316_317_318_319_320_321_322_323_324_325_326_327_328_329_330_GC start GC done.
331_332_333_334_335_336_337_338_339_340_341_342_343_344_345_346_347_348_349_350_351_352_353_354_355_356_357_358_359_360_361_362_363_364_365_366_367_368_369_370_371_372_373_374_375_376_377_378_379_380_381_382_383_384_385_386_387_388_389_390_391_392_393_394_395_396_397_398_399_400_401_402_403_404_405_406_407_408_409_410_411_412_413_414_415_416_417_418_419_420_421_422_423_424_425_426_427_428_429_430_431_432_433_434_435_436_437_438_439_440_441_442_443_444_445_446_447_448_449_450_451_452_453_454_455_456_457_458_459_460_461_462_463_464_465_466_467_468_469_470_471_472_473_474_475_476_477_478_479_480_481_482_483_484_485_486_487_488_489_490_491_492_493_494_495_496_497_498_499_GC start GC done.
500_501_502_503_504_505_506_507_508_509_510_511_512_513_514_515_516_517_518_519_520_521_522_523_524_525_526_527_528_529_530_531_532_533_534_535_536_537_538_539_540_541_542_543_544_545_546_547_548_549_550_551_552_553_554_555_556_557_558_559_560_561_562_563_564_565_566_567_568_569_570_571_572_573_574_575_576_577_578_579_580_581_582_583_584_585_586_587_588_589_590_591_592_593_594_595_596_597_598_599_600_601_602_603_604_605_606_607_608_609_610_611_612_613_614_615_616_617_618_619_620_621_622_623_624_625_626_627_628_629_630_631_632_633_634_635_636_637_638_639_640_641_642_643_644_645_646_647_648_649_650_651_652_653_654_655_656_657_658_659_660_661_662_663_664_665_666_667_GC start GC done.
668_669_670_671_672_673_674_675_676_677_678_679_680_681_682_683_684_685_686_687_688_689_690_691_692_693_694_695_696_697_698_699_700_701_702_703_704_705_706_707_708_709_710_711_712_713_714_715_716_717_718_719_720_721_722_723_724_725_726_727_728_729_730_731_732_733_734_735_736_737_738_739_740_741_742_743_744_745_746_747_748_749_750_751_752_753_754_755_756_757_758_759_760_761_762_763_764_765_766_767_768_769_770_771_772_773_774_775_776_777_778_779_780_781_782_783_784_785_786_787_788_789_790_791_792_793_794_795_796_797_798_799_800_801_802_803_804_805_806_807_808_809_810_811_812_813_814_815_816_817_818_819_820_821_822_823_824_825_826_827_828_829_830_831_832_833_834_835_836_GC start GC done.
837_838_839_840_841_842_843_844_845_846_847_848_849_850_851_852_853_854_855_856_857_858_859_860_861_862_863_864_865_866_867_868_869_870_871_872_873_874_875_876_877_878_879_880_881_882_883_884_885_886_887_888_889_890_891_892_893_894_895_896_897_898_899_900_901_902_903_904_905_906_907_908_909_910_911_912_913_914_915_916_917_918_919_920_921_922_923_924_925_926_927_928_929_930_931_932_933_934_935_936_937_938_939_940_941_942_943_944_945_946_947_948_949_950_951_952_953_954_955_956_957_958_959_960_961_962_963_964_965_966_967_968_969_970_971_972_973_974_975_976_977_978_979_980_981_982_983_984_985_986_987_988_989_990_991_992_993_994_995_996_997_998_999_1000_()
0]
8. You're posting your findings as per Item 7 above here.
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb Ave.scm
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
(define average
(lambda (input)
(print (/ (apply + input) (length input))) (newline)
)
)
AVERAGE
(average (list 0 1 2 3 4 5 6 7 8 9))
4.500000
T
0](average '(0 1 2 3 4 5 6 7 8 9))
4.500000
T
0](average '(0 1 2 3 4 5 6 7 8 9))
4.500000
T
0](average '(0 1 2 3 4 5 6 7 8 9))
4.500000
T
0](average '(0 1 2 3 4 5 6 7 8 9))
4.500000
T
0]
Not sure if I can use it tho. My scriba.exe wasn't fully set up;
Where are the flowers, champagne and heavenly music? I have become a Hero Member on this forum ...
I would like to display SBLisp version .## or something like that ...
and remove the old QB version startup.
If this project holds your interest...At the current complexity of the source code and with a usable error.bas include, I can manage in a simple Notepad and an incremental debugger isn't really necessary for me (I think...)
' This work is licensed under the Creative Commons
' Attribution-NonCommercial-ShareAlike License. To view a copy of this
' license, visit http://creativecommons.org/licenses/by-nc-sa/3.0/ or
' send a letter to Creative Commons, 171 Second St, Suite 300
' San Francisco, CA 94105, USA.
' The original author of this code is Arthur Nunes-Harwitt
' SBLisp version by John Spikowski and Mike Lobanovsky - Aug. 8th, 2014
' Bitbucket Repository: https://bitbucket.org/ScriptBasic/sblisp
I just don't see the need for it to be displayed every time at startup.That's correct.
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
SBLisp - Scheme BASIC Lisp
0]
' SBLisp version by John Spikowski and Mike Lobanovsky - Aug. 8th, 2014
' Bitbucket Repository: https://bitbucket.org/ScriptBasic/sblisp
'
' This work is licensed under the Creative Commons
' Attribution-NonCommercial-ShareAlike License. To view a copy of this
' license, visit http://creativecommons.org/licenses/by-nc-sa/3.0/ or
' send a letter to Creative Commons, 171 Second St, Suite 300
' San Francisco, CA 94105, USA.
'
' The original author of this code is Arthur Nunes-Harwitt
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
SBLisp - Scheme BASIC Lisp
0](/ 12 2 3)
2
0]; Works under Linux
0](quit)
Bye!
jrs@laptop:~/sb/sb22/sblisp$
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb Ave.scm
SBLisp - Scheme BASIC Lisp
(define average
(lambda (input)
(print (/ (apply + input) (length input))) (newline)
)
)
AVERAGE
(average (list 0 1 2 3 4 5 6 7 8 9))
4.500000
T
0]
What's next?It seems reasonable to make BASIC LISP look more like standard Scheme. E.g. (print) isn't Scheme while (display) is. A list of missing functionality and keywords would be welcome.
It would be nice to have a help feature in SBLisp.Not feasible. The 19-page PDF is the absolute minimum to allow a BASIC-er to write the simplest LISP lambda. Been there, done that.
Can we eliminate the limitations (MAX settings) on arrays so we can deal with larger / more complex scripts?Something's telling me this problem is non-existent in SB with its dynamic-only arrays. Once the initial arrays are created and initialized, they may grow on and on automatically as their newer elements are referred to for the first time.
I would like to have a tutorial/instructions on adding new symbols to SBLisp.Let's have a list of missing keywords first (see above) -- that's what postage stamp collectors would call a manque-liste a-la francais -- and then try to implement the simplest ones that have very close correspondence to the existing ones, e.g. trigonometric functions. This will develop a "feeling" for the source code structure and teach us what is what in it and why. Then more complicated cases may be tackled as our experience grows.
What is the format you plan to use for external resources (SDL, SQLite, Scheme library sets (pkg), ...)I don't have any particular plans for now. Frankly, I'm not interested in that language very much as it is. It's more about that sort of a drive that I'm feeling while cracking all these brainteasers in a piece of alien code.
P.S. I would like to see the current FBSL version of SBLisp if you have time to post or point us to a link to download.You can download raw source code and a precompiled executable (http://www.fbsl.net/phpbb2/viewtopic.php?f=26&t=3028#p10561) from the FBSL site.
Let me know when you think SBLisp is solid...Time and tests will show. AS IS ==> no warranties given, no responsibility assumed. This isn't my own code after all. I would have never written it in this style in the first place, or I would've rewritten it a hundred times since the 90s.
I don't have any particular plans for now.
It seems reasonable to make BASIC LISP look more like standard Scheme.
You can download raw source code and a precompiled executable from the FBSL site.
That updated zip looks a bit dated and still has the (/ ...) error.Ain't no slightest idea what you're talking about. See the picture of (/ ...) running in the exe and raw script modes. I have just downloaded the zip from the site.
Your last post says redownload the zip. The file dates say 8/9.The second picture is what my file dates and times say in my Russian WinRAR. August the 9th has ended exactly 3 hours ago here. It's 3 o'clock in the morning Sunday August 10.
I'm still confused about what you said that SB expands it's arrays beyond the initialized state. Isn't there max array size variables being set to check for exceeding these predefined states?Judging from what I read in Peter's docs, you might not need any initialization at all. If it is so, then SB's arrays behave exactly like FBSL's dynamic arrays: their elements are created totally on the fly at the moment they are referenced in the code for the first time if they haven't been referenced yet.
maxheapsize=4000
'FOR mem = 0 TO maxheapsize
' heaptype[mem,0] = 0
' heaptype[mem,1] = 0
' heapvalue[mem,0] = 0
' heapvalue[mem,1] = 0
'NEXT mem
maxsymboltablesize = 2000
FOR mem = 0 TO maxsymboltablesize
symbols[mem] = ""
NEXT mem
slotsfilled = 0
maxstacksize = 2000
'FOR mem = 0 TO maxstacksize
' stacktype[mem] = 0
' stackvalue[mem] = 0
'NEXT mem
Used your recommended settings for the max values and never saw a GC message well over five minutes into it. 8)
IF hpcursor + 3 > maxheapsize THEN
bsd += 1
GOSUB GarbageCollect
END IF
you send me a 64-bit scriba.exe for Windows.
Quoteyou send me a 64-bit scriba.exe for Windows.
C:\Users\John>cd \sb22_64\sblisp
C:\sb22_64\sblisp>sb64 lisp.sb
SBLisp - Scheme BASIC Lisp
0](load 'rectest.scm)
(define rectest (lambda (x)
(cond ((<= x (* 10000)) (rectest (+ x 1))))
))
RECTEST
(rectest 1)
GC start GC done.
GC start GC done.
GC start GC done.
GC start GC done.
()
0]
9997
9998
9999
10000
10001
()
(quit)
Bye!
real 11m58.927s
user 10m57.221s
sys 1m0.044s
jrs@laptop:~/sb/sb22/sblisp$
I assume you are already doing something like this for FBSL. (REDIM to expand array)Yes, DIM[1K]/REDIM PRESERVE[UBOUND+1K] would be the fastest scheme to follow. Upon closer consideration, it would be the most flexible too. This is because FBSL's dynamic arrays, fast as they are, are growable but not shrinkable; you can't UNDEF an FBSL dynamic array. OTOH REDIM and even REDIM PRESERVE work both ways and are fast enough in batch (re)allocation. In one-element-at-a-time (re)allocations however they would work at approximately the same speeds as what we're seeing in SB now.
I rarely use multithreading in my work so I can't recollect off the top of my head if the memory allocated in one thread can be preserved for use in another one once the worker thread exits.
A GC cycle is a huge piece of CPU- and memory-intensive work to execute so it should be avoided at all costs whenever possible.
FOR x = 0 to 99999
a[x] = 0
NEXT x
PRINT UBOUND(a),"\n"
jrs@laptop:~/sb/sb22/sblisp$ time scriba fornext.sbSPLITA STRING(100000,"0") BY "" TO a
PRINT UBOUND(a),"\n"
I'm not showing off or something.
Where did you hear me say I was going to evaluate ScriptBASIC?
This command swaps two variables.
*/
COMMAND(SWAP)
#if NOTIMP_SWAP
NOTIMPLEMENTED;
#else
LEFTVALUE VariableA,VariableB;
pFixSizeMemoryObject VSWAP;
long refcount;
/* we get the pointer to the variable that points to the value */
VariableA = EVALUATELEFTVALUE(PARAMETERNODE);
ASSERTOKE;
/* if this points to a reference value then we search the "real" variable
to modify */
DEREFERENCE(VariableA);
/* get the next parameter of the command, which is the other variable */
NEXTPARAMETER;
/* we get the pointer to the variable that points to the value */
VariableB = EVALUATELEFTVALUE(PARAMETERNODE);
ASSERTOKE;
/* if this points to a reference value then we search the "real" variable
to modify */
DEREFERENCE(VariableB);
VSWAP = *VariableA;
*VariableA = *VariableB;
*VariableB = VSWAP;
#endif
END
ISINTEGER
ISNUMERIC
ISDEFINED
ACOSECANT
HCOSECANT
FILEOWNER
TIMEVALUE
ADDMINUTE
ADDSECOND
RANDOMIZE
DIRECTORY
ISSTRING
COSECANT
INSTRREV
FREEFILE
NEXTFILE
ENVIRONS
ADDMONTH
HOSTNAME
TEXTMODE
FUNCTION
TRUNCATE
CLOSEALL
FILECOPY
ISARRAY
ISUNDEF
ISEMPTY
ASECANT
HSECANT
STRINGS
REPLACE
FILELEN
ENVIRON
COMMAND
ADDRESS
WEEKDAY
YEARDAY
ADDYEAR
ADDHOUR
ADDWEEK
EXECUTE
WAITPID
BINMODE
DELTREE
SPLITAQ
PRINTNL
DECLARE
PATTERN
MAXINT
MININT
STRING
LBOUND
UBOUND
ISREAL
COTAN2
SECANT
UCASES
UPPERS
LCASES
LOWERS
LTRIMS
RTRIMS
RIGHTS
SPACES
OPTION
ERRORS
ISFILE
CURDIR
FORMAT
GMTIME
MINUTE
ADDDAY
SYSTEM
REGION
OUTPUT
DELETE
REPEAT
UNPACK
MODULE
SPLITA
ELSEIF
RESUME
GLOBAL
RETURN
REWIND
BYVAL
FALSE
UNDEF
ROUND
LOG10
UCASE
LCASE
LTRIM
RTRIM
RIGHT
SPACE
JOKER
CHOMP
ACTAN
COTAN
HCTAN
UPPER
LOWER
TRIMS
LEFTS
INSTR
ERROR
INPUT
MONTH
ICALL
CRYPT
PRINT
CONST
LOCAL
ELSIF
CHDIR
MKDIR
GOSUB
PAUSE
QUOTE
ENDIF
SPLIT
ALIAS
CLOSE
RESET
WHILE
UNTIL
SLEEP
LIKE
ASIN
ACOS
EVEN
TRUE
CINT
FRAC
MKDS
MKIS
MKSS
MKLS
TRIM
LEFT
TYPE
ATAN
HCOS
HSIN
HTAN
TAN2
MIDS
CHRS
STRS
HEXS
OCTS
JOIN
IMAX
IMIN
PACK
TIME
YEAR
HOUR
CONF
KILL
FORK
WEND
FILE
LOOP
SWAP
LINE
NAME
OPEN
FROM
WILD
THEN
NEXT
LOCK
EXIT
STEP
ELSE
NULL
GOTO
CALL
ELIF
STOP
SEEK
AND
XOR
NOT
SIN
COS
SGN
ODD
GCD
LCM
SQR
RND
ABS
VAL
FIX
INT
CVD
CVI
CVL
CVS
MKD
MKI
MKS
MKL
LOG
POW
EXP
LEN
ASC
MID
CHR
STR
HEX
OCT
RAD
ATN
TAN
BIN
MAX
MIN
LOC
LOF
EOF
EOD
NOW
DAY
SEC
REF
VAR
SET
POP
LET
FOR
END
LIB
SUB
OR
PI
IF
ON
DO
TO
NO
BY
GO
AS
GMTIMETOLOCALTIME
LOCALTIMETOGMTIME
FILEACCESSTIME
FILEMODIFYTIME
FILECREATETIME
STRREVERSES
ISDIRECTORY
STRREVERSE
FILEEXISTS
FORMATDATE
FORMATTIME
' Mike's SWAP array test
a[0]=0
a[1]=1
a[2]=2
b[0]=2
b[1]=1
b[2]=0
SWAP a, b
PRINT a[0],"\n"
PRINT a[1],"\n"
PRINT a[2],"\n"
a = 1
b = 2
SWAP a, b
PRINT "A: ",a,"\n"
PRINT "B: ",b,"\n"
a[0]=0
a[1]=1
a[2]=2
b[0]=2
b[1]=1
b[2]=0
PRINT "------------\n"
PRINT a[0]," ",a[1]," ",a[2],"\n"
PRINT "------------\n"
PRINT b[0]," ",b[1]," ",b[2],"\n"
PRINT "------------\n"
ref c = a
ref d = b
SWAP c, d
PRINT a[0]," ",a[1]," ",a[2],"\n"
PRINT "------------\n"
PRINT b[0]," ",b[1]," ",b[2],"\n"
PRINT "------------\n"
No need to repeat yourself over and over again.
Peter Verhas truly is the hero here.
And, er, actually I am the BASIC developer.
0](< 2 3)
()
1 ]=> (< 2 3)
;Value: #t
0](<= 2 3)
T
Are you saying that FBSL is now you're baby? (single developer effort)
Mike,
Personally I would like to see F rather than () for false.
0](> 2 1)
()
0]
1 ]=> (> 2 1)
;Value: #t
1 ]=>
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
SBLisp - Scheme BASIC Lisp
0](< 2 3)
T
0](> 2 1)
T
0](quit)
Bye!
jrs@laptop:~/sb/sb22/sblisp$
0](atan 1)
0.785398
0]
9998
9999
10000
10001
()
(quit)
Bye!
real 0m10.187s
user 0m9.641s
sys 0m0.468s
jrs@laptop:~/sb/sb22/sblisp$
9997
9998
9999
10000
10001
()
(quit)
Bye!
real 11m58.927s
user 10m57.221s
sys 1m0.044s
jrs@laptop:~/sb/sb22/sblisp$
1092
1093
1094
1095
1096
GC start A broken heart.
real 0m1.289s
user 0m1.132s
sys 0m0.036s
jrs@laptop:~/sb/sb22/sblisp$
9997
9998
9999
10000
10001
()
(quit)
Bye!
real 0m9.455s
user 0m9.133s
sys 0m0.252s
jrs@laptop:~/sb/sb22/sblisp$
The purpose of the following function is to help balance a checkbook. The function prompts the user for an initial balance. Then it enters the loop in which it requests a number from the user, subtracts it from the current balance, and keeps track of the new balance. Deposits are entered by inputting a negative number. Entering zero (0) causes the procedure to terminate and print the final balance.
(define checkbook (lambda ()
; This check book balancing program was written to illustrate
; i/o in Scheme. It uses the purely functional part of Scheme.
; These definitions are local to checkbook
(letrec
; These strings are used as prompts
((IB "Enter initial balance: ")
(AT "Enter transaction (- for withdrawal): ")
(FB "Your final balance is: ")
; This function displays a prompt then returns
; a value read.
(prompt-read (lambda (Prompt)
(display Prompt)
(read)))
; This function recursively computes the new
; balance given an initial balance init and
; a new value t. Termination occurs when the
; new value is 0.
(newbal (lambda (Init t)
(if (= t 0)
(list FB Init)
(transaction (+ Init t)))))
; This function prompts for and reads the next
; transaction and passes the information to newbal
(transaction (lambda (Init)
(newbal Init (prompt-read AT)))))
; This is the body of checkbook; it prompts for the
; starting balance
(transaction (prompt-read IB)))))
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
SBLisp - Scheme BASIC Lisp
0](load 'ckbook.scm)
(define checkbook (lambda ()
(letrec
((IB "Enter initial balance: ")
(AT "Enter transaction (- for withdrawal): ")
(FB "Your final balance is: ")
(prompt-read (lambda (Prompt)
(display Prompt)
(read)))
(newbal (lambda (Init t)
(if (= t 0)
(list FB Init)
(transaction (+ Init t)))))
(transaction (lambda (Init)
(newbal Init (prompt-read AT)))))
(transaction (prompt-read IB)))))
CHECKBOOK
ERROR: Read.
ERROR: Problem in file ckbook.scm
0]
jrs@laptop:~/sb/sb22/sblisp$ mit-scheme
MIT/GNU Scheme running under GNU/Linux
Type `^C' (control-C) followed by `H' to obtain information about interrupts.
Copyright (C) 2014 Massachusetts Institute of Technology
This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
Image saved on Saturday May 17, 2014 at 2:39:25 AM
Release 9.2 || Microcode 15.3 || Runtime 15.7 || SF 4.41 || LIAR/x86-64 4.118 || Edwin 3.116
1 ]=> (load 'ckbook.scm)
;The object ckbook.scm, passed as an argument to merge-pathnames, is not a pathname.
;To continue, call RESTART with an option number:
; (RESTART 1) => Return to read-eval-print level 1.
2 error> (load "ckbook.scm")
;Loading "ckbook.scm"... done
;Value: checkbook
2 error>
There ain't no such command ...
SB uses int/double/string within its variant construct.
SWAP(active_array, passive_array)
in FBSL, and by somewhat more elaborate ref vars in SB:REF active_array = array0
REF passive_array = array1
SWAP active_array, passive_array
Go figure how to deinterlace all this mess when you're nearing your sixties and doubting whether it's all worth the effort .
We were lucky enough to have SWAP(array,array) or its equivalent in all the three languages. Otherwise I would've given up immediately even before array splitting. That's because one must be completely out of one's mind to even imagine anything that would resemble Aurel's "solution" to the problem even remotely.
SBLisp = Toy?
Lego? ?
Erector Set? ? ?
...solve some of its short comings.Like what for example? What problems can you solve using a tool that is exactly one thousand times slower than the finely tuned mechanism you're so set to repair?! John, SB and FBSL are only some 120 times slower than VC or GCC. SB/FBSL LISPs are yet an order of magnitude slower than this compared to their SB and FBSL hosts!
I don't know about that boy. It's gotten to the point I have to leave him in the car when going out in public. I think it's your turn to watch him for awhile.Have a look here (http://www.oxygenbasic.org/forum/index.php?topic=1163.msg10455#msg10455). I was literally begging this ... ... ... to stop sh... ...ting in my thread before the addressee even has a chance to respond. All in vain. ... ... ... ...!
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
SBLisp - Scheme BASIC Lisp
0](define fibonacci (lambda (n)
2](if (( n 2)
4]n
4](+ (fibonacci (- n 1))
5](fibonacci (- n 2)))))
2])
1])
FIBONACCI
0](fibonacci 26)
ERROR: Bad type in car.
0]
Gosub is implemented in Oxygen. It translates directly to call label.
To terminate a gosub, ret must be used, rather than return.
F0 F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12 F13 F14 F15 F16 F17 F18 F19 F20
0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765
jrs@laptop:~/sb/sb22/sblisp$ time scriba lisp.sb fibonacci.scm
SBLisp - Scheme BASIC Lisp
(define fibonacci (lambda (n)
(if (< n 2)
n
(+ (fibonacci (- n 1))
(fibonacci (- n 2)))))
)
FIBONACCI
(fibonacci 12)
144
(quit)
Bye!
real 0m0.464s
user 0m0.452s
sys 0m0.008s
jrs@laptop:~/sb/sb22/sblisp$
DoLoad:
ptype = qtype
pvalue = qvalue
bsd += 1
GOSUB Car
bsd += 1
GOSUB RregtoPreg
IF ptype <> symbol THEN
PRINT "ERROR: Load needs a symbol.\n"
GOTO HandleError
END IF
lispfilename = symbols[pvalue]
OPTION COMPARE sbCaseInsensitive
fnpos = INSTR(ibuf, lispfilename)
IF fnpos THEN lispfilename = MID(ibuf, fnpos, LEN(lispfilename))
OPTION COMPARE sbCaseSensitive
lispfilenum = 1
bsd += 1
GOSUB LispOpenInputFile
gtc=now
WHILE NOT EOF(lispfilenum)
stkcursor = 0
curenv = globalenv
bsd += 1
GOSUB LispRead
bsd += 1
GOSUB RregtoPreg
bsd += 1
GOSUB LispEval
bsd += 1
GOSUB RregtoPreg
bsd += 1
GOSUB LispPrint
PRINTNL
WEND
print "Done in ",now-gtc," seconds\n"
bsd += 1
GOSUB LispCloseFile
rtype = booleant
rvalue = TRUE
bsd -= 1
RETURN
Calculate percentage difference
between V1 = 13.797 and V2 = 10.734
( | V1 - V2 | / ((V1 + V2)/2) ) * 100
= ( | 13.797 - 10.734 | / ((13.797 + 10.734)/2) ) * 100
= ( | 3.063 | / (24.531/2) ) * 100
= ( 3.063 / 12.2655 ) * 100
= 0.249725 * 100
= 24.9725% difference
FBSL has lots of ways to improve on this code. It's me that's pulling it to wait till you catch up. I'm a generous man, you know
Code: [Select]Calculate percentage difference
between V1 = 13.797 and V2 = 10.734
( | V1 - V2 | / ((V1 + V2)/2) ) * 100
= ( | 13.797 - 10.734 | / ((13.797 + 10.734)/2) ) * 100
= ( | 3.063 | / (24.531/2) ) * 100
= ( 3.063 / 12.2655 ) * 100
= 0.249725 * 100
= 24.9725% difference
You missed your chance for the moment of true glory. I thought you would do it in BASIC LISP
Where's my time app, please?
ptime-10.zip (23.94 kB - downloaded 1 times.)
GC start GC done.
GC start GC done.
46368
(quit)
Bye!
real 1m43.305s
user 1m43.078s
sys 0m0.036s
jrs@laptop:~/sb/sb22/sblisp$
Grab your calculator and enjoy yet another shining moment of triumph but don't forget to raise a glass to Peter Verhas.
FBLisp (Freestyle BASIC Lisp)
Here is my run on Ubuntu 64 bit on my Intel® Pentium(R) CPU P6200 @ 2.13GHz × 2 laptop.Not bad by the looks of it.
real 1m43.305s
user 1m43.078s
sys 0m0.036s
I always wanted to have such a thing in Windows but I couldn't figure out how. MS Windows discloses dozens of statistical parameters relevant to ring 3 (user space) but none relevant to ring 1 (kernel space). So yes, here I envy you and my envy is black. :)Should get the FreeBASIC group buzzing.I don't give a damn about FreeBUZZIC's buzzing. Freestyle BASIC Script Language has been around since June 2001. I am in my own right with the letters F, B, S, and L in this very succession. I've yet to see them trying to register the FB abbreviation against Zuckerberg's FaceBook, hehe...
I thought I would take a shot at converting GOSUB's to SUB's.Hmmm, not sure if you've seen my comments on this issue in the last paragraph of my earlier message here (http://www.oxygenbasic.org/forum/index.php?topic=1147.msg10508#msg10508).
Embeddable Common Lisp (ECL) is a LGPL Common Lisp implementation aimed at producing a small-footprint Lisp system that can be embedded into existing C-based applications. It is able to create stand-alone ELF executables from Common Lisp code and runs on most platforms that support a C compiler.
Because it compiles Common Lisp to C, it also features an FFI system, including support for inline C to be used or generated from Common Lisp. Inline C FFI combined with Common Lisp macros and custom SETF expansions yield a compile-time preprocessor.
;;; -*- mode: common-lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;;
;;; (c) 2011, Juan Jose Garcia-Ripoll
;;;
;;; Set up the test environment.
;;;
(defpackage :ecl-tests
(:use :cl))
(in-package :ecl-tests)
(setf *load-verbose* nil *load-print* nil)
(defvar *ecl-sources*
(loop for *default-pathname-defaults* in
'(#p"/home/jrs/ecl/src/" #p"../../" #p"../../src/")
when (probe-file "CHANGELOG")
return *default-pathname-defaults*))
(defvar *test-sources* (merge-pathnames "tests/" *ecl-sources*))
(defvar *here* (merge-pathnames "./"))
(defvar *cache* (merge-pathnames "./cache/" *here*))
(defvar *test-image* (or (ext:getenv "TEST_IMAGE")
#+windows
(namestring (truename #+windows "sys:ecl.exe"))
#-windows
"ecl"))
(defvar *test-image-args*
(cond ((search "ecl" *test-image*)
'("-norc" "-eval" "(print (ext:getenv \"ECLDIR\"))"
;#+windows "-eval" #+windows "(require :cmp)"
))
((search "sbcl" *test-image*)
'("--no-userinit" "--no-sysinit"))
(t
'())))
#+ecl
(ext:setenv "ECLDIR" (namestring (truename "SYS:")))
(defvar *test-name* (or (ext:getenv "TEST_NAME") "ecl"))
(defvar *output-directory*
(merge-pathnames (concatenate 'string "output." *test-name* "/") *here*))
(defvar *quicklisp-sandbox* (merge-pathnames "quicklisp/" *here*))
(defvar *quicklisp-install-file* (merge-pathnames "quicklisp.lsp" *cache*))
(defvar *quicklisp-setup-file* (merge-pathnames "setup.lisp" *quicklisp-sandbox*))
(defvar *regressions-sources* (merge-pathnames "bugs/" *test-sources*))
(defvar *regressions-sandbox* (merge-pathnames "regressions/" *here*))
(defvar *ansi-tests-mirror* "http://ecls.sourceforge.net/ansi-tests.tar.gz")
(defvar *ansi-tests-sandbox* (merge-pathnames "ansi-tests/" *here*))
(defvar *ansi-tests-tarball* "ansi-tests.tar.gz")
(defvar *mop-tests-mirror* "http://ecls.sourceforge.net/mop-features.tar.gz")
(defvar *mop-tests-sandbox* (merge-pathnames "mop-features/" *here*))
(defvar *mop-tests-tarball* "mop-features.tar.gz")
(defvar *fricas-mirror* "http://ecls.sourceforge.net/fricas.tar.gz")
(defvar *fricas-sandbox* (merge-pathnames "fricas/" *here*))
(defvar *fricas-tarball* "fricas.tar.gz")
(defvar *wild-inferiors* (make-pathname :name :wild
:type :wild
:version :wild
:directory '(:relative :wild-inferiors)))
(defvar *cleanup-extensions* '("fasl" "fasb" "c" "h" "obj" "o" "a" "lib" "dll" "dylib" "data"))
(defun lisp-system-directory ()
(loop with root = (si::get-library-pathname)
with lib-name = (format nil "../lib/ecl-~A/" (lisp-implementation-version))
for base in (list root (merge-pathnames lib-name root))
when (or (probe-file (merge-pathnames "./BUILD-STAMP" base))
(probe-file (merge-pathnames "./LGPL" base)))
do (return base)))
(setf (logical-pathname-translations "SYS")
(list (list #p"sys:**;*.*"
(merge-pathnames "**/*.*"
(lisp-system-directory)))))
(require :cmp)
(require :ecl-curl)
(require :deflate)
(require :ql-minitar)
;;;
;;; PREPARATION OF DIRECTORIES AND FILES
;;;
(defun setup-asdf ()
(require :asdf)
(ensure-directories-exist *cache*)
(setf (symbol-value (read-from-string "asdf::*user-cache*"))
(list *cache* :implementation)))
(defun delete-everything (path)
;; Recursively run through children
(labels ((recursive-deletion (path)
(mapc #'delete-everything
(directory (merge-pathnames
(make-pathname :name nil
:type nil
:directory '(:relative :wild)
:defaults path)
path)))
;; Delete files
(loop for f in (directory (make-pathname :name :wild
:type :wild
:defaults path))
do (delete-file f)
finally (delete-file path))))
(and (probe-file path)
(recursive-deletion path))))
(defun safe-download (url filename)
(ensure-directories-exist filename)
(handler-case
(ecl-curl:download-url-to-file url filename)
(ecl-curl:download-error (c)
(format t "~&;;;~%;;; Unable to download quicklisp. Aborting. ~%;;;")
(ext:quit 1)))
filename)
(defun download-quicklisp-install ()
(safe-download "http://beta.quicklisp.org/quicklisp.lisp"
*quicklisp-install-file*))
(defun download-and-setup-quicklisp ()
(when (probe-file *quicklisp-sandbox*)
(delete-everything *quicklisp-sandbox*))
(handler-case
(progn
(load (download-quicklisp-install))
(let ((function (read-from-string "quicklisp-quickstart:install")))
(eval (list function :path *quicklisp-sandbox*))))
(error (c)
(format t "~&;;;~%;;; Unable to setup quicklisp. Aborting.~%;;;")
(delete-everything *quicklisp-sandbox*))))
(defun ensure-quicklisp ()
(unless (find-package "QL")
(unless (probe-file *quicklisp-sandbox*)
(setup-asdf)
(download-and-setup-quicklisp))
(load *quicklisp-setup-file*))
t)
(defun copy-directory (orig dest)
(setf orig (truename orig))
(print dest)
(loop for f in (directory (merge-pathnames *wild-inferiors* orig))
for f2 = (enough-namestring f orig)
for f3 = (merge-pathnames f2 dest)
unless (probe-file f3)
do (ensure-directories-exist f3)
do (ext:copy-file f f3)))
(defun extract-tarball (filename)
(format t "~&;;;~%;;; Extracting ~a~%;;;" filename)
(if (string-equal (pathname-type filename) "gz")
(let ((temp-filename (ext:mkstemp "fooXXXXXXX")))
(unwind-protect
(progn
(deflate:gunzip filename temp-filename)
(extract-tarball temp-filename))
(delete-file temp-filename)))
(ql-minitar:unpack-tarball filename)))
(defun extract-distribution (filename url)
(let ((distribution (loop for base in (list *cache*
*here*
*test-sources*)
for file = (merge-pathnames filename base)
when (probe-file file)
do (return file)
finally (let ((tmp (merge-pathnames filename *cache*)))
(return (safe-download url tmp))))))
(extract-tarball distribution)))
(defun ensure-regressions ()
(unless (probe-file *regressions-sandbox*)
(copy-directory *regressions-sources* *regressions-sandbox*)))
(defun ensure-ansi-tests ()
(unless (probe-file *ansi-tests-sandbox*)
(extract-distribution *ansi-tests-tarball* *ansi-tests-mirror*))
t)
(defun ensure-mop-tests ()
(unless (probe-file *mop-tests-sandbox*)
(extract-distribution *mop-tests-tarball* *mop-tests-mirror*))
t)
(defun ensure-fricas ()
(unless (probe-file *fricas-sandbox*)
(extract-distribution *fricas-tarball* *fricas-url*)))
(defun ensure-maxima ()
(unless (probe-file *fricas-sandbox*)
(extract-distribution *fricas-tarball* *fricas-url*)))
(defun cleanup-directory (path)
(loop for i in (directory (merge-pathnames *wild-inferiors*
path))
when (member (pathname-type i) *cleanup-extensions* :test #'string-equal)
do (delete-file i)))
;;;
;;; RUNNING TESTS
;;;
(defun run-ansi-tests (&optional (output (merge-pathnames "ansi.log"
*output-directory*)))
(ensure-ansi-tests)
;; Cleanup stray files
(cleanup-directory *ansi-tests-sandbox*)
(delete-everything (merge-pathnames "scratch/" *ansi-tests-sandbox*))
;; Run with given image
(ensure-directories-exist output)
(let* ((input (merge-pathnames "doit.lsp" *ansi-tests-sandbox*))
(tmp (merge-pathnames "ecl-tmp-doit.lsp" *ansi-tests-sandbox*)))
(with-open-file (s tmp :direction :output
:if-exists :supersede
:if-does-not-exist :create)
(format s "(require :cmp)
#+ecl(setf c::*suppress-compiler-messages* '(or c::compiler-note c::style-warning))
(pprint (ext:getcwd))
(load ~S)
#+ecl(quit)"
(namestring input)))
(unwind-protect
(progn
(ext:chdir *ansi-tests-sandbox*)
(ext:run-program *test-image*
*test-image-args*
:input tmp
:output output
:error :output
:wait t))
(when (probe-file tmp)
(ignore-errors (delete-file tmp)))
(ext:chdir *here*))))
(defun run-regressions-tests (&optional (output (merge-pathnames "regressions.log"
*output-directory*)))
(ensure-regressions)
;; Cleanup stray files
(cleanup-directory *regressions-sandbox*)
;; Run with given image
(ensure-directories-exist output)
(unwind-protect
(progn
(ext:chdir *regressions-sandbox*)
(ext:run-program *test-image*
*test-image-args*
:input (merge-pathnames "doit.lsp" *regressions-sandbox*)
:output output
:error :output))
(ext:chdir *here*)))
(defun run-mop-tests (&optional (output (merge-pathnames "mop-features.log"
*output-directory*)))
(ensure-mop-tests)
;; Cleanup stray files
(cleanup-directory *mop-tests-sandbox*)
;; Create the script we are going to run
(let ((mop-script (merge-pathnames "./run-mop-tests.lisp" *mop-tests-sandbox*)))
(with-open-file (s mop-script :direction :output
:if-exists :supersede
:if-does-not-exist :create)
(pprint '(progn
(require :asdf)
(load "lw-compat-package")
(load "lw-compat")
(load "mop-features-packages.lisp")
(load "mop-feature-tests.lisp")
(handler-case
(progn
(funcall (read-from-string "mop-feature-tests::run-feature-tests"))
(format t "~%~%~%MOP-FEATURE-TESTS: OK"))
(error (error)
(format t "~%~%~%MOP-FEATURE-TESTS: Failed"))))
s))
;; Run with given image
(ensure-directories-exist output)
(unwind-protect
(progn
(ext:chdir *mop-tests-sandbox*)
(ext:run-program *test-image*
*test-image-args*
:input mop-script
:output output
:error :output))
(ext:chdir *here*))))
(defvar *quicklisp-library-list*
'(trivial-features
alexandria
babel
cffi
cl-ppcre
cl-unicode
iterate
trivial-gray-streams
trivial-garbage
flexi-streams
lift
metabang-bind
swank
stefil
sqlite
chunga
cl+ssl
cl-base64
cl-fad
cl-python
md5
rfc2388
trivial-backtrace
trivial-gray-streams
usocket
hunchentoot))
(defconstant +quicklisp-build-template+ "
(require 'asdf)
(setf (symbol-value (read-from-string \"asdf::*user-cache*\"))
(list ~s :implementation))
(load ~s)
(ql:use-only-quicklisp-systems)
(handler-case
(progn
(ql:quickload ~s)
(princ \"ECL-BUILD-OK\"))
(serious-condition (c) (princ c)))
#+ecl
(ext:quit)
#+sbcl
(sb-ext:quit)
")
(defconstant +quicklisp-test-template+ "
(require 'asdf)
(setf (symbol-value (read-from-string \"asdf::*user-cache*\"))
(list ~s :implementation))
(load ~s)
(ql:use-only-quicklisp-systems)
(handler-case
(progn
(ql:quickload ~s)
(princ \"ECL-BUILD-OK\")
(asdf:oos 'asdf:test-op ~:*~s)
(princ \"ECL-TEST-OK\"))
(serious-condition (c) (princ c)))
#+ecl
(ext:quit)
#+sbcl
(sb-ext:quit)
")
(defun run-quicklisp-tests (&optional (output (merge-pathnames "quicklisp.log"
*output-directory*)))
(mapcar #'delete-everything (directory (merge-pathnames "*/" *cache*)))
(let ((quicklisp-logs (merge-pathnames "quicklisp.logs/" *output-directory*)))
(labels ((build-or-test-job (name suffix template)
(let* ((name (string-downcase name))
(log-name (concatenate 'string name suffix))
(build-log (ensure-directories-exist
(merge-pathnames log-name quicklisp-logs))))
(multiple-value-bind (stream status process)
(ext:run-program *test-image*
*test-image-args*
:input :stream
:output build-log
:error :output
:wait nil)
(unwind-protect
(progn
(format stream template
(namestring *cache*)
(namestring *quicklisp-setup-file*)
name)
(format t template
(namestring *cache*)
(namestring *quicklisp-setup-file*)
name)
(force-output stream))
(close stream)
(ext:external-process-wait process t)
))))
(build-job (name)
(build-or-test-job name "-build.log" +quicklisp-build-template+))
(test-job (name)
(build-or-test-job name "-test.log" +quicklisp-test-template+)))
(mapc #'build-job *quicklisp-library-list*)
(mapc #'test-job *quicklisp-library-list*))))
(load-foreign-library #p"/usr/lib/libmysqlclient.so"
:module "mysql"
:supporting-libraries '("c"))
=> T
Apart from that, this ECL thingy looks like an exact match to SB's own design and workflow in its Linux hypostasis. The other platforms may be satisfied with a standalone SB interpreter and its matching LISP bytecode interpreter plug-in.
I hope that FBSL not being ported to Linux yet doesn't keep you away from experimenting with tools on that platform.
We used SB as a testing ground for proof of concept. It's just easy to use.Naturally enough, FBSL is the easiest for me. Oxygen stays the toughest. The OxyLISP evaluator still fails me, or rather I'm failing as an O2 user.
I can't thank you enough for all the help and code bringing that to a reality.Thank you for the kind words. Actually I'm a steppen wolf when coding but this thread did bring a lot of life and entertainment to my LISP dev experience.
(defun fibonacci (n)
(if (< n 3)
1
(+ (fibonacci (- n 1)) (fibonacci (- n 2))) ) )
(loop for i from 1 to 24
do (format t "~D, " (fibonacci i))
finally (format t "...~%") )
<suspicion> Or are you implying you've gone that far in putting your SBLisp on the GCL rails?! :o </suspicion>
You mean, speed-wise?
cmd = COMMAND()
SPLIT cmd BY " " TO DEBUG, filename
cmdln = COMMAND()
SPLITA TRIM(cmdln) BY " " TO cmdlnargs
dbgflg = FALSE
FOR x = 0 TO UBOUND(cmdlnargs)
IF TRIM(UCASE(cmdlnargs[x])) = "-D" THEN
dbgflg = TRUE
ELSE IF TRIM(cmdlnargs[x]) <> undef THEN
cmdflg = TRUE
cmdlnfn = TRIM(cmdlnargs[x])
ELSE
cmdflg = FALSE
END IF
NEXT
(compile-file "fibonacci.lsp" :system-p t)
(c:build-program "fibonacci" :lisp-files '("fibonacci.o"))
#include<stdio.h>
int Fibonacci(int);
int main()
{
int n = 24, i = 0, c;
printf("Fibonacci series\n");
for ( c = 1 ; c <= n + 1 ; c++ )
{
printf("%d\n", Fibonacci(i));
i++;
}
return 0;
}
int Fibonacci(int n)
{
if ( n == 0 )
return 0;
else if ( n == 1 )
return 1;
else
return ( Fibonacci(n-1) + Fibonacci(n-2) );
}
FUNCTION Fibonacci(n)
IF n = 0 THEN
Fibonacci = 0
ELSE IF n = 1 THEN
Fibonacci = 1
ELSE
Fibonacci = Fibonacci(n - 1) + Fibonacci(n - 2)
END IF
END FUNCTION
PRINT "Fibonacci series\n"
FOR x = 1 TO 24
PRINT Fibonacci(x),"\n"
NEXT
GetSymbol:
total = 0
opos = ipos
smb = 1
slength = FALSE
GetHashNumLoop:
IF ipos = LEN(ibuf) + 1 THEN GOTO CheckExistance
curchar = UCASE(MID(ibuf, ipos, 1))
IF slength = TRUE THEN
IF curchar = "\"" THEN
ipos += 1
GOTO CheckExistance
ELSE
GOTO DoStrLiteral
END IF
ELSE
IF curchar = "\"" THEN
ipos += 1
opos = ipos
slength = TRUE
END IF
END IF
IF INSTR(" ()'", curchar) THEN GOTO CheckExistance
DoStrLiteral:
temp = ASC(curchar) * smb + total
total = temp - (INT(temp / maxsymboltablesize) * maxsymboltablesize)
temp = smb * 256
smb = temp - (INT(temp / maxsymboltablesize) * maxsymboltablesize)
ipos += 1
GOTO GetHashNumLoop
CheckExistance:
IF symbols[total] = "" THEN GOTO PutInTable
temp = symbols[total]
IF temp = UCASE(MID(ibuf, opos, ipos - opos + slength)) THEN
ctype = symbol
cvalue = total
bsd -= 1
RETURN
END IF
temp = total * total
total = temp - (INT(temp / maxsymboltablesize) * maxsymboltablesize)
GOTO CheckExistance
PutInTable:
IF slotsfilled = maxsymboltablesize THEN
PRINT "ERROR: Symbol table full.\n"
END
END IF
symbols[total] = UCASE(MID(ibuf, opos, ipos - opos + slength))
ctype = symbol
cvalue = total
slotsfilled += 1
bsd -= 1
RETURN
SUB GetSymbol
total = 0
opos = ipos
smb = 1
slength = FALSE
GetHashNumLoop:
IF ipos = LEN(ibuf) + 1 THEN GOTO CheckExistance
curchar = UCASE(MID(ibuf, ipos, 1))
IF slength = TRUE THEN
IF curchar = "\"" THEN
ipos += 1
GOTO CheckExistance
ELSE
GOTO DoStrLiteral
END IF
ELSE
IF curchar = "\"" THEN
ipos += 1
opos = ipos
slength = TRUE
END IF
END IF
IF INSTR(" ()'", curchar) THEN GOTO CheckExistance
DoStrLiteral:
temp = ASC(curchar) * smb + total
total = temp - (INT(temp / maxsymboltablesize) * maxsymboltablesize)
temp = smb * 256
smb = temp - (INT(temp / maxsymboltablesize) * maxsymboltablesize)
ipos += 1
GOTO GetHashNumLoop
CheckExistance:
IF symbols[total] = "" THEN GOTO PutInTable
temp = symbols[total]
IF temp = UCASE(MID(ibuf, opos, ipos - opos + slength)) THEN
ctype = symbol
cvalue = total
bsd -= 1
EXIT SUB
END IF
temp = total * total
total = temp - (INT(temp / maxsymboltablesize) * maxsymboltablesize)
GOTO CheckExistance
PutInTable:
IF slotsfilled = maxsymboltablesize THEN
PRINT "ERROR: Symbol table full.\n"
END
END IF
symbols[total] = UCASE(MID(ibuf, opos, ipos - opos + slength))
ctype = symbol
cvalue = total
slotsfilled += 1
bsd -= 1
END SUB
SUB GetSymbol
total = 0
opos = ipos
smb = 1
slength = FALSE
GetHashNumLoop:
IF ipos = LEN(ibuf) + 1 THEN GOTO CheckExistance
curchar = UCASE(MID(ibuf, ipos, 1))
IF slength = TRUE THEN
IF curchar = "\"" THEN
ipos += 1
GOTO CheckExistance
ELSE
GOTO DoStrLiteral
END IF
ELSE
IF curchar = "\"" THEN
ipos += 1
opos = ipos
slength = TRUE
END IF
END IF
IF INSTR(" ()'", curchar) THEN GOTO CheckExistance
DoStrLiteral:
temp = ASC(curchar) * smb + total
total = temp - (INT(temp / maxsymboltablesize) * maxsymboltablesize)
temp = smb * 256
smb = temp - (INT(temp / maxsymboltablesize) * maxsymboltablesize)
ipos += 1
GOTO GetHashNumLoop
CheckExistance:
IF symbols[total] = CHR(0) THEN GOTO PutInTable
temp = symbols[total]
IF temp = UCASE(MID(ibuf, opos, ipos - opos + slength)) THEN
ctype = symbol
cvalue = total
bsd -= 1
EXIT SUB
END IF
temp = total * total
total = temp - (INT(temp / maxsymboltablesize) * maxsymboltablesize)
GOTO CheckExistance
PutInTable:
IF slotsfilled = maxsymboltablesize THEN
PRINT "ERROR: Symbol table full.\n"
END
END IF
symbols[total] = UCASE(MID(ibuf, opos, ipos - opos + slength))
ctype = symbol
cvalue = total
slotsfilled += 1
bsd -= 1
END SUB
Here is Fibonacci 24 with the new version.
Is that good or bad?
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
SBLisp - Scheme BASIC Lisp
0]' "Thanks Mike for the fix!"
THANKS MIKE FOR THE FIX!
0](quit)
Bye!
jrs@laptop:~/sb/sb22/sblisp$
> (fib 3)
2
> (fib 3)
8
> (fib 3)
34
> (fib 3)
144
> (fib 3)
610
IF INSTR(" ()'", curchar) THEN GOTO CheckExistance
IF INSTR(" ()'", curchar) <> undef THEN GOTO CheckExistance
What does this new SBLisp structure do to our LISP in BASIC common effort ? Are you still sticking with the QB format?We absolutely must find a way to formulate the remaining GoSub's as Subs even if it leads to duplicating some pieces of relevant GoTo code. Otherwise it will be impossible to use this code for either DynC or CBASIC that don't support labels which are accessible with both a call (=GoSub) and a jump (=GoTo) at the same time.
Their SB logic in both cases evaluates to IF TRUE THEN GOTO (I tested and confirmed it) but if the second variant looks more natural to you, you can safely use it in your SBLisp code. I can read both notations equally fast and it doesn't distract or annoy me.Code: [Select]IF INSTR(" ()'", curchar) THEN GOTO CheckExistance
Shouldn't this be ...Code: [Select]IF INSTR(" ()'", curchar) <> undef THEN GOTO CheckExistance
Their SB logic in both cases evaluates to IF TRUE THEN GOTO ...
GetNumber:
total = VAL(curchar)
BuildNumberLoop:
IF decimalp THEN decimal += 1
ipos += 1
IF ipos > LEN(ibuf) THEN GOTO MakeNumber
curchar = MID(ibuf, ipos, 1)
IF curchar = "." THEN
IF NOT decimalp THEN
decimalp = TRUE
GOTO BuildNumberLoop
ELSE
ipos = opos
GetSymbol()
RETURN
END IF
END IF
IF curchar >= "0" AND curchar <= "9" THEN
total = total * 10 + VAL(curchar)
GOTO BuildNumberLoop
END IF
IF INSTR("()'", curchar) <> undef OR curchar <= " " THEN
GOSUB MakeNumber
RETURN
END IF
ipos = opos
GetSymbol()
RETURN
We absolutely must find a way to formulate the remaining GoSub's as Subs even if it leads to duplicating some pieces of relevant GoTo code. Otherwise it will be impossible to use this code for either DynC or CBASIC that don't support labels which are accessible with both a call (=GoSub) and a jump (=GoTo) at the same time.
Mike , gazonk0.o is 1308 bytesThanks Rob. With such a size, it looks like a program launcher only rather than the CL main code file.
OOps , Jack ...Yes Rob, your timing for the 10000th fibonumber also seems absolutely impossible to me. It takes 222 seconds for DynC to find the 52nd one and it would take years to find the 60th. 20 milliseconds are simply unrealistic.
seems I hit an iceberg
We have already run into this in SBLisp where an undef result compare was needed.This is a trickier case with intermediate logical evaluation involved due to OR. Similar OR evaluations were also buggy in Charles' O2 until very recently when Ed's Toy interpreter started to function due to Charles having fixed up this very bug.Code: [Select]IF INSTR("()'", curchar) <> undef OR curchar <= " " THEN
I agree but this was a good first step.Sure and thanks for taking it. :)
I hope to get Arthur back on-board with this. We have exchanged a couple e-mails.Was it Arthur who pointed you to ECL?
Was it Arthur who pointed you to ECL?
Maybe making larger SUB/FUNCTION that encapsulates more common functionality.Do you think you could do it for the project? The proc size and code duplication would be no problem at this stage. Then it will be easier to spot the duplicates and reduce them to yet finer common Subs until eliminated entirely. There's almost no difference in the overhead of a jump or call in a variant-based interpreter so it shouldn't affect its execution speed noticeably. At the same time, it will enable us to later turn the Sub calls from the existing IF tree into a call table (computed gotos) for DynC, C, and O2. It could improve the speed of their machine-coded interpretation.
Do you think you could do it for the project?
... what calls what. Is that something you could generate quickly?Hehe it would be a trivial task for a machine code executable and almost any decent disassembler out there would provide you with one in a few seconds. But it's impossible to have for an indie interpreter written in yet another interpreter. It would require a separate program and thorouh knowledge of the structure of both languages. :)
I would like to see a real Scheme script run in S|FBLisp that actually does something useful. This would at least tell us if the syntax of the language works.There are hardly many useful app tasks that would fit into the Procrustean bed of XFLisp's current vocabulary. But looking for one might really trigger its development. (I'm still not able to make OxyLISP's evaluator work with anything other than numbers... :-\ )
But it's impossible to have for an indie interpreter written in yet another interpreter. It would require a separate program and thorouh knowledge of the structure of both languages.
0](eq? (list 'a 'b) (list 'a 'b))
()
0](equal? (list 'a 'b) (list 'a 'b))
T
0](+ 4 (* 5 6))
34
0](define x 6)
X
0](+ (* 5 x x) (* 4 x) 3)
207
0](/ 21 5)
4.200000
FUNCTION PushStack
stacktype[stkcursor] = ptype
stackvalue[stkcursor] = pvalue
stkcursor += 1
IF stkcursor > maxstacksize THEN
PRINT "ERROR: Stack overflow.\n"
PushStack = FALSE
EXIT FUNCTION
ELSE
PushStack = TRUE
END IF
bsd -= 1
END FUNCTION
...
IF NOT PushStack() THEN GOTO HandleError
This is how I'm dealing with GOSUBs that don't call anything other than the HandleError: routine.That's OK for FBLisp too.
show what this thing is capable ofHehe so you want me to be doing it? But John, I'm a GUI guy, I don't really see why you are all so happy with this ugly black hole in your monitors. ;D
BTW this one seems to be correct as per the PDF but I can't quite see the reason why. And the PDF doesn't describe this case clear enough to catch the idea behind "however, lists may look similar, but not be identical"... ??? Is it because the one on the left is the first term in this evaluation while the one on the right is the second one? Mystery...Code: [Select]0](eq? (list 'a 'b) (list 'a 'b))
()
(eq? (list 'a 'b) (list 'a 'b))
But John, I'm a GUI guy, I don't really see why you are all so happy with this ugly black hole in your monitors.
Hehe, can we write a console Tetris or Space Invaders in this XBlisp thingy and (re)register at that retro-BASIC serpentarium on account of underlying BASIC? ;D
... a console Tetris or Space Invaders ...
... a console Tetris or Space Invaders ...
Running a console in Windows is like "driving" a Bentley that's tied to a horse's tail.
Quote... a console Tetris or Space Invaders ...
Windows Console? :)
Windows Console?
If I wasn't a software developer, I would be a click & touch person as well.
We all have our own way of defining comfortable.
Hehe, can we write a console Tetris or Space Invaders in this XBlisp thingy and (re)register at that retro-BASIC serpentarium on account of the underlying BASIC? ;D
http://www.takeoka.org/~take/trek/trek-man-e.html
(... preferring the command line on Windows ...)
PLEASE TEST !!!
Would you accept help from humble point & click lamer nobodies trespassing the sacred lands of Holy Mother Console and Divine Allmighty Terminal?
Is F compliant with LISP syntax?
; initdr.scm Gordon S. Novak Jr. 31 Aug 00
; Definitions to add to Dr. Scheme: add the following to your file:
; (load "initdr.scm")
(define pi 3.1415926535)
(define (1+ n) (+ n 1))
(define (1- n) (- n 1))
; While-Do macro: (while c s1 ... sn)
; Example: (let ((n 0)) (while (< n 3) (write n) (newline) (set! n (1+ n))))
(define-macro while (lambda (c . s)
(list 'do '() (list (list 'not c)) (cons 'begin s))))
; dotimes as in Common Lisp
; Example: (dotimes (j 3) (write j) (newline))
(define-macro dotimes (lambda (args . s)
(let ((maxvar (gensym 'dotimes-count)))
(list 'do
(list (list (car args) 0 (list '+ 1 (car args)))
(list maxvar (cadr args)))
(list (list '>= (car args) maxvar)
(if (null? (cddr args)) #f (caddr args)))
(cons 'begin s)) ) ))
; dolist as in Common Lisp
(define-macro dolist (lambda (args . s)
(let ((lstvar (gensym 'dolist-ptr)))
(list 'do
(list (list lstvar (cadr args) (list 'cdr lstvar))
(list (car args) #f) )
(list (list 'null? lstvar)
(if (null? (cddr args)) #f (caddr args)))
(cons 'begin (cons (list 'set! (car args) (list 'car lstvar))
s)) ) )))
; Versions of standard Lisp functions in Scheme
(define (copy-list l)
(if (pair? l)
(cons (car l) (copy-list (cdr l)))
l))
(define (copy-tree x)
(if (pair? x)
(cons (copy-tree (car x))
(copy-tree (cdr x)))
x))
; Simple subst similar to copy-tree
(define (subst new old tree)
(if (pair? tree)
(cons (subst new old (car tree))
(subst new old (cdr tree)))
(if (eqv? old tree)
new
tree)))
; More efficient subst
(define (subst new old tree)
(if (pair? tree)
(let ((left (subst new old (car tree)))
(right (subst new old (cdr tree))))
(if (and (eq? left (car tree))
(eq? right (cdr tree)))
tree
(cons left right)))
(if (eqv? old tree)
new
tree)))
; Simple sublis similar to copy-tree
(define (sublis alist tree)
(if (pair? tree)
(cons (sublis alist (car tree))
(sublis alist (cdr tree)))
(if (assv tree alist)
(cdr (assv tree alist))
tree)))
; More efficient sublis
(define (sublis alist tree)
(if (pair? tree)
(let ((left (sublis alist (car tree)))
(right (sublis alist (cdr tree))))
(if (and (eq? left (car tree))
(eq? right (cdr tree)))
tree
(cons left right)))
(let ((new (assv tree alist)))
(if new
(cdr new)
tree) ) ) )
(define (intersection x y)
(if (pair? x)
(if (memv (car x) y)
(cons (car x) (intersection (cdr x) y))
(intersection (cdr x) y))
'()))
(define (union x y)
(if (pair? x)
(if (memv (car x) y)
(union (cdr x) y)
(cons (car x) (union (cdr x) y)))
y))
(define (set-difference x y)
(if (pair? x)
(if (memv (car x) y)
(set-difference (cdr x) y)
(cons (car x) (set-difference (cdr x) y)))
'()))
(define (subset pred lst)
(if (pair? lst)
(if (pred (car lst))
(cons (car lst)
(subset pred (cdr lst)))
(subset pred (cdr lst)))
'() ) )
(define (subset? x l)
(if (pair? x)
(and (memv (car x) l)
(subset? (cdr x) l))
(null? x)) )
(define (every pred lst)
(if (pair? lst)
(if (pred (car lst))
(every pred (cdr lst))
#f)
#t) )
(define (some pred lst)
(if (pair? lst)
(or (pred (car lst))
(some pred (cdr lst)))
#f))
(define (nconc x y)
(define (nconc2 x y)
(if (pair? (cdr x))
(nconc2 (cdr x) y)
(set-cdr! x y)))
(if (pair? x)
(begin (nconc2 x y) x)
y) )
(define (nreverse x)
(let ((last '()) (tmp '()))
(while (pair? x)
(set! tmp (cdr x))
(set-cdr! x last)
(set! last x)
(set! x tmp))
last))
; Time the execution of the specified form.
(define-macro time (lambda (form)
(let ((var (gensym 'time-var)))
(list 'let (list (list var '(current-seconds)))
form
(list '- '(current-seconds) var)) )))
; Convert a floating-point number to a string of sign and at most 4 characters.
; Rounds the number so that 1.999 will come out as 2.00 , very small as 0.0 .
; numstring is written assuming that num is not too large or too small,
; i.e. num must be printable in 4 digits.
(define (numstring num)
(let* ((numc (abs num)) (sign (if (< num 0) -1 1)) (exponent 0))
(if (< numc 1.0e-6)
"0.0"
(begin
(if (< numc 1.0)
(begin (while (< numc 100)
(set! numc (* numc 10))
(set! exponent (1- exponent)))
(set! numc (* (round numc) (expt 10 exponent))) )
(set! numc (* numc 1.0001)))
(if (< sign 0)
(string-append "-"
(substring (number->string numc) 0
(min 4 (string-length (number->string numc)))))
(substring (number->string numc) 0
(min 4 (string-length (number->string numc))))) ) ) ))
; additions thanks to Michael Bogomolny:
(define (test-expression expr)
(display "> ") (write expr) (newline)
(write (eval expr)) (newline) (newline) 'ok)
(define (turnin lst)
(if (null? lst)
'done
(begin
(test-expression (car lst))
(turnin (cdr lst)))))
(define some? some)
(define every? every)
(print-vector-length #f)
(require-library "trace.ss")
; was drgraphics.scm Gordon S. Novak Jr. 24 Aug 00
; Some graphics routines for DrScheme:
; The following is for DrScheme version 102:
(require-library "graphics.ss" "graphics")
; These routines are compatible with MacGambit and use the
; following conventions:
; (0,0) is at the center of the window
; +y is upward.
; You can change the size of the drawing window by changing
; the parameters *hsize* and *vsize* below before starting.
; Thanks to Dustin Friesenhahn for adding color.
; (clear-graphics) ; erase the drawing window
; (position-pen x y) ; move the pen to (x,y) without drawing
; (draw-line-to x y) ; draw from current pen position to (x,y)
; (graphics-text string x y) ; draw the string in the window at (x,y)
; e.g. (graphics-text "Hi, Mom!" 0 0)
; DrScheme specific function
; (graphics-string-size str) ; returns list (width height) of str
; ; in integer units of pixels
(define *hsize* 409) ; horizontal size of drawing viewport
(define *vsize* 428) ; vertical size of drawing viewport
(define *xoffset* 200) ; x offset of coordinates
(define *yoffset* 200) ; y offset of coordinates
(define *vp* #f) ; viewport
(define *lastpt* #f) ; last point
(define *color* (make-rgb 0 0 0)) ; init to black
; Use the viewport *vp* or open one if needed
(define (viewport)
(or *vp*
(begin
(open-graphics)
(set! *vp* (open-viewport "CS 307" *hsize* *vsize*))
(clear-graphics)
*vp*)))
(define (clear-graphics)
((clear-viewport (viewport)))
(position-pen 0 0) )
; fix a number to be an exact integer
(define (fix x)
(if (and (integer? x)
(exact? x))
x
(if (exact? x)
(round x)
(inexact->exact (round x)))))
; convert from upward y to downward y as used by DrScheme
; MacGambit uses center of window as (0,0)
(define (yconvert y) (fix (- *yoffset* y)))
(define (xconvert x) (fix (+ *xoffset* x)))
; position the pen to specified point
(define (position-pen x y)
(or *vp* (viewport))
(set! *lastpt* (make-posn (xconvert x) (yconvert y))))
; draw a line from last point to specified point
(define (draw-line-to x y)
(let ((newpt (make-posn (xconvert x) (yconvert y))))
(begin
((draw-line (viewport)) *lastpt* newpt *color*)
(set! *lastpt* newpt))))
; draw a string beginning at specified (x, y)
(define (graphics-text string x y)
((draw-string (viewport))
(make-posn (xconvert x) (yconvert y))
string *color*))
; DrScheme specific graphics-string-size
; returns list (width height) of a string in pixels
; Michael Bogomolny - spring 2001
(define (graphics-string-size str)
(let ((temp ((get-string-size (viewport)) str)))
(list (fix (car temp))
(fix (cadr temp)))))
; set color to be used in drawing
; Each color value must be between 0 and 1.
(define (set-color! red green blue)
(if (and (number? red) (>= red 0) (<= red 1)
(number? green) (>= green 0) (<= green 1)
(number? blue) (>= blue 0) (<= blue 1))
(set! *color* (make-rgb red green blue)) ) )
(Just downloaded. Need time to test.)
BTW sblisp.exe in the repo seems not updated -- still prints Bye!.
jrs@laptop:~/sb/sb22/sblisp$ cd ~/repos/sblisp
jrs@laptop:~/repos/sblisp$ git add SBLisp_exe.zip
jrs@laptop:~/repos/sblisp$ git commit -m "Updaded Windows 32 standalone SBLisp.exe"
[master bc32b87] Updaded Windows 32 standalone SBLisp.exe
1 file changed, 0 insertions(+), 0 deletions(-)
rewrite SBLisp_exe.zip (96%)
jrs@laptop:~/repos/sblisp$ git push
Password for 'https://ScriptBasic@bitbucket.org':
To https://ScriptBasic@bitbucket.org/ScriptBasic/sblisp.git
619c627..bc32b87 master -> master
jrs@laptop:~/repos/sblisp$
Go have a rest.
hope others do the same.
I'd rather spend more time on trying to enrich the structure and vocabulary of the two versions that are currently functioning. What do you think?
Others are enjoying Sunday morning while someone else is still stuck in Saturday night.
I would let Charles take the current SBLisp source and try to make it work.Well, I wouldn't. Firstly, his Lispish is our competitor and secondly, I'm ashamed to publish non-working code. That would be somehow unbecoming even if you don't take me for a developer. :)
As a possible side benefit he may find a better way than the GOSUBs we are currently pondering.We've already discussed those better ways while fiddling with Ed's Toy interpreter. As a result of our discussion, FBSL is now stuck up to its ears with all sorts of such better ways.
You did send that check or is the mail just a little slow?Nope, it isn't. Everything was done in just one lo-o-o-o-o-o-ng twinkling of the eye. :P
Well, I wouldn't. Firstly, his Lispish is our competitor and secondly, I'm ashamed to publish non-working code.
I would let Charles take the current SBLisp source and try to make it work.
Pretend you're Peter and just keep it to yourself. :-*
Lisp::SBL_Init()
Lisp::SBL_CmdStr()
Lisp::SBL_CmdFile()
Lisp::SBL_Close()
Can you create a simple plot ... in SBLisp ...
besFUNCTION(gfx_Mandelbrot)
DIM AS double cx, cy, zx, zy, tp;
DIM AS int iter;
besARGUMENTS("rri")
AT cx, AT cy, AT iter
besARGEND
DEF_WHILE (zx * zx + zy * zy < 4 AND iter > 0)
BEGIN_WHILE
tp = zx * zx - zy * zy + cx;
zy = 2 * zx * zy + cy;
zx = tp;
iter = iter - 1;
WEND
besRETURN_LONG(iter);
besEND
' ScriptBasic GFX - Mandelbrot
IMPORT gfx.inc
s = gfx::Window(640,480,"ScriptBasic GFX Mandelbrot")
ts = gfx::Time()
FOR y = 0 TO 479
FOR x = 0 TO 639
cx = (x - 320) / 120
cy = (y - 240) / 120
rit = gfx::Mandelbrot(cx, cy, 510)
gfx::PixelRGBA s, x, y, rit * 12, rit * 8, rit * 4, 255
NEXT
NEXT
te = gfx::Time()
gfx::stringColor s, 20, 15, "Time: " & FORMAT("%.4f",(te-ts)/1000) & " Seconds." & CHR(0), 0x000000ff
gfx::Update
WHILE gfx::KeyName(1) <> "+escape"
WEND
gfx::Close
You're making the exact same mistake that Peter and others were doing in their Oldschool Plasma code.
This Mandelbrot iterator is a verbatim port ...This is exactly why I mentioned Peter; you weren't on the alert while porting.
... of the code posted on this forum.This forum deals with code compilable to native code. Even so it can contain pitfalls especially when compiled by Oxygen that has no optimization mechanisms to rearrange pieces of inefficient code automatically. It cost Peter 20% of his FPS and I don't know how much these duplicate zx*zx and zy*zy would cost the O2 Mandelbrot code creator whoever that was.
#APPTYPE CONSOLE
MandelB()
MandelC()
PAUSE
SUB MandelB()
DIM i, j, r, x, y
DIM k = 1
DIM s = " .:-;!/>)|&IH%*#" // leading space inside quotes!
FOR y = -16 TO 15
FOR x = 0 TO 78
PRINT s{INCR(k BAND 15)} ; // no new line! // this is equivalent to s[(k & 15)] in C but here s{n} starts at n = 1 contrary to C's s[n] where n would start at 0
LET(i, r) = 0 // this is equivalent to i = r = 0 in C
FOR k = 0 TO 111
j = r ^ 2 - i ^ 2 - 2 + x / 25
i = 2 * r * i + y / 10
r = j
IF j ^ 2 + i ^ 2 > 11 THEN EXIT FOR
NEXT
NEXT
PRINT // new line
NEXT
END SUB
DYNC MandelC()
void main()
{
float i, j, r;
float x, y = -16;
int k = 1;
while (puts(""), y++ < 15) {
for (x = 0; x++ < 84; putchar(" .:-;!/>)|&IH%*#"[k & 15])) { // leading space inside quotes!
for (i = k = r = 0;
j = r * r - i * i - 2 + x / 25, i = 2 * r * i + y / 10, j * j + i * i < 11 && k++ < 111;
r = j);
}
}
}
END DYNC
OK, I'll tinker something (tomorrow , I have some time to do so ) -- it's infact easier than the prime sieve (and if some time I'll make one too -- the idea is clear (mapping a function that gives the number of divisors over a list -- it is possible, I checked the parts to do so :)Thanks for the great news! I'll be keeping my fingers crossed. :)
If you should have some time -- just to confirm this is sensible talk .... ==> etc. etc. etc.Whom are these questions addressed to? Yes, your new program runs visibly much faster than the previous one. And yes, the link points to the description of how the Bigloo native code compiler would treat mangled and unmangled names from C object files and vice versa when linking the resultant executable. And yes again, it describes the syntax to use in both Bigloo and C scripts to generate object names that would allow this foreign interface to pass data in both directions.
I need those buffered graphicsWhere do you need them, please? In thinBasic, OxygenBasic, ScriptBASIC, FBSL, SBLisp, FBLisp, Lispish or anywhere else? What environment exactly are we talking about here?
otherwise I can better switch to language thas can address those arraysSwitch over from what language, please? I see you coding in many languages at once so which one of them will you have to abandon?
#DEFINE INCR_CDR_ERROR bsd += 1 \
IF NOT Cdr() THEN \
HandleError() \
EXIT SUB \
END IF
would spare us 4 lines in maybe a hundred places throughout the code without adding unwanted extra returns that would otherwise overlay the EXIT SUB which in fact we are after.
would spare us 4 lines in maybe a hundred places throughout the code without adding unwanted extra returns that would otherwise overlay the EXIT SUB which in fact we are after.
jrs@laptop:~/ecl/examples/jrs$ cat hello_ecl.c
#include <ecl/ecl.h>
int main(int argc, char **argv) {
cl_boot(argc, argv);
cl_object obj=c_string_to_object("\"Hello world\"");
cl_pprint(1,obj);
printf("\n");
cl_shutdown();
}jrs@laptop:~/ecl/examples/jrs$ gcc hello_ecl.c -lecl -o hello_ecl
jrs@laptop:~/ecl/examples/jrs$ ./hello_ecl
"Hello world"
jrs@laptop:~/ecl/examples/jrs$ ls -l hello_ecl
-rwxrwxr-x 1 jrs jrs 8788 Aug 18 01:18 hello_ecl
jrs@laptop:~/ecl/examples/jrs$
I thought our goal was to get rid of GOSUB/GOTO and put everything into SUB/FUNCTION routines for the BASIC level side of the conversion?
Can you create a custom FUNCTION/SUB for that?Forget it. I was just looking for a more efficient way to denote pieces of repeatable code without turning it into yet another nested level of Subs. If there's no such a way, so be it.
I'm looking forward to what Mike comes up withResuming my work right away.
I haven't given up on SB ECL yet.Why should you? ECL is by far more able than SBLisp and will always be.
From there my question if the provided documentation was sensible.Entirely sensible, precise, and comprehensive. The best of the two worlds. :)
"Übung macht den Meister" 8)Jawohl! :)
i can address allocatable memory now from within BiglooCongratulations and thanks for the sample! :)
Why should you? ECL is by far more able than SBLisp and will always be.
Guys i am not sure but i think that i see ( one one site ..sorry i don't remeber where) that there is a version of Lisp written in sinclair QL superBasic.
Here is the API I need to use to create a SB ECL extension module in C BASIC.So what's missing to have it created?
So what's missing to have it created?
#include <ecl/object.h>
#include <ecl/external.h>
#include <ecl/cons.h>
#include <ecl/stacks.h>
#include <ecl/number.h>
#include <ecl/legacy.h>
sblisp wordt niet herkend als een interne
of externe opdracht, programma of batchbestand.
sblisp.exe lib.lisp fibonacci.lispcommand line isn't possible but I'm currently reworking its code and I will add this functionality too.
' <Mike> ....
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb Xblisp002.txt
SBLisp - Scheme BASIC Lisp
(define divisor?
(lambda (p q)
ERROR: Read.
ERROR: Problem in file Xblisp002.txt
ERROR: Bad type.
0]
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp_gold.sb Xblisp002.txt
SBLisp - Scheme BASIC Lisp
(define divisor?
(lambda (p q)
ERROR: Read.
ERROR: Problem in file Xblisp002.txt
0]
SBLISP
------
LIST=(2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206
207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251
252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
297 298 299)
FILTERING_PRIMES_BY_MAPPING
(2 3 0 5 0 7 0 0 0 11 0 13 0 0 0 17 0 19 0 0 0 23 0 0 0 0 0 29 0 31 0 0 0 0 0 37 0 0 0 41 0 43 0 0 0 47 0 0 0 0 0 53 0 0 0 0 0 59 0 61 0 0 0 0 0 67 0 0 0 71 0 73 0 0 0 0 0 79 0 0 0
83 0 0 0 0 0 89 0 0 0 0 0 0 0 97 0 0 0 101 0 103 0 0 0 107 0 109 0 0 0 113 0 0 0 0 0 0 0 0 0 0 0 0 0 127 0 0 0 131 0 0 0 0 0 137 0 139 0 0 0 0 0 0 0 0 0 149 0 151 0 0 0 0 0 157 0
0 0 0 0 163 0 0 0 167 0 0 0 0 0 173 0 0 0 0 0 179 0 181 0 0 0 0 0 0 0 0 0 191 0 193 0 0 0 197 0 199 0 0 0 0 0 0 0 0 0 0 0 211 0 0 0 0 0 0 0 0 0 0 0 223 0 0 0 227 0 229 0 0 0 233 0
0 0 0 0 239 0 241 0 0 0 0 0 0 0 0 0 251 0 0 0 0 0 257 0 0 0 0 0 263 0 0 0 0 0 269 0 271 0 0 0 0 0 277 0 0 0 281 0 283 0 0 0 0 0 0 0 0 0 293 0 0 0 0 0 0)
....FINISHED..........
T
0]
Please find the initialization of flag badluck = 666 and change it to, say, badluck = 100 and see if it works in Linux...
jrs@U32VB:~/sb22/sblisp$ ../bin/scriba lisp.sb Xblisp002.txt
SBLisp - Scheme BASIC Lisp
(define divisor?
(lambda (p q)
ERROR: Read.
ERROR: Problem in file Xblisp002.txt
ERROR: Bad type.
0]
jrs@U32VB:~/sb22/sblisp$ ../bin/scriba lisp.sb Xblisp002.txt
SBLisp - Scheme BASIC Lisp
(define divisor?
(lambda (p q)
ERROR: Read.
ERROR: Problem in file Xblisp002.txt
ERROR: Bad type.
0](quit)
jrs@U32VB:~/sb22/sblisp$
jrs@U32VB:~/sb22/sblisp$ ./SBLisp Xblisp002.txt
SBLisp - Scheme BASIC Lisp
(define divisor?
(lambda (p q)
ERROR: Read.
ERROR: Problem in file Xblisp002.txt
ERROR: Bad type.
0]
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb Xblisp002.txt
SBLisp - Scheme BASIC Lisp
(define divisor?
(lambda (p q)
(let (( x (/ p q)))
(if (= x (floor x)) 1 0 ))))
DIVISOR?
(define more-divisorsx
(lambda ( i x nr)
(if (or (> i (/ x 2)) (> nr 0 ) ) nr
(more-divisorsx (+ i 1) x (+ nr (divisor? x i))))))
MORE-DIVISORSX
(define more-divisors
(lambda (x)
(more-divisorsx 2 x 0)))
MORE-DIVISORS
(define prime?
(lambda (x)
(if (= (more-divisors x) 0 ) x 0 )))
PRIME?
(define make-listx
(lambda (i x L)
(if (= i x) L
(make-listx (+ i 1) x (cons i L)))))
MAKE-LISTX
(define make-list
(lambda (x)
(reverse (make-listx 2 x '() ))))
MAKE-LIST
(define sq (make-list 300))
SQ
(define main
(lambda ()
(newline)
(newline)
(newline)
(newline)
(print 'SBLisp ) (newline)
(print '------ ) (newline) (newline)
(print 'List= )
(print sq)
(newline)
(newline)
(print 'Filtering_primes_by_mapping)
(newline)
(let (( res (map prime? sq)))
(print res)
(newline)
(print '....finished )
(print '..... )
)))
MAIN
(main)
SBLISP
------
LIST=(2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299)
FILTERING_PRIMES_BY_MAPPING
(2 3 0 5 0 7 0 0 0 11 0 13 0 0 0 17 0 19 0 0 0 23 0 0 0 0 0 29 0 31 0 0 0 0 0 37 0 0 0 41 0 43 0 0 0 47 0 0 0 0 0 53 0 0 0 0 0 59 0 61 0 0 0 0 0 67 0 0 0 71 0 73 0 0 0 0 0 79 0 0 0 83 0 0 0 0 0 89 0 0 0 0 0 0 0 97 0 0 0 101 0 103 0 0 0 107 0 109 0 0 0 113 0 0 0 0 0 0 0 0 0 0 0 0 0 127 0 0 0 131 0 0 0 0 0 137 0 139 0 0 0 0 0 0 0 0 0 149 0 151 0 0 0 0 0 157 0 0 0 0 0 163 0 0 0 167 0 0 0 0 0 173 0 0 0 0 0 179 0 181 0 0 0 0 0 0 0 0 0 191 0 193 0 0 0 197 0 199 0 0 0 0 0 0 0 0 0 0 0 211 0 0 0 0 0 0 0 0 0 0 0 223 0 0 0 227 0 229 0 0 0 233 0 0 0 0 0 239 0 241 0 0 0 0 0 0 0 0 0 251 0 0 0 0 0 257 0 0 0 0 0 263 0 0 0 0 0 269 0 271 0 0 0 0 0 277 0 0 0 281 0 283 0 0 0 0 0 0 0 0 0 293 0 0 0 0 0 0)
....FINISHED..........
T
0]
I'm glad it wasn't a SB thing.But it is! Actually it's a design fault! Why don't I have to think about where my files come from? And why my TRIM() would chomp and trim everything that's whitespace no matter where it comes from -- Windows, Unix, or Mac?!
beware: now that you've got me hooked on Linux and are playing truant, you may easily lose your leading place in the acknowledgment blurb, hehe...
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb Xblisp003.txt
SBLisp - Scheme BASIC Lisp
(define divisor?
(lambda (p q)
(let (( x (/ p q)))
(if (= x (floor x)) 1 0 ))))
DIVISOR?
(define more-divisorsx
(lambda ( i x nr)
(if (or (> i (/ x 2)) (> nr 0 ) ) nr
(more-divisorsx (+ i 1) x (+ nr (divisor? x i))))))
MORE-DIVISORSX
(define more-divisors
(lambda (x)
(more-divisorsx 2 x 0)))
MORE-DIVISORS
(define prime?
(lambda (x)
(if (= (more-divisors x) 0 ) x 0 )))
PRIME?
(define make-listx
(lambda (i x L)
(if (= i x) L
(make-listx (+ i 1) x (cons i L)))))
MAKE-LISTX
(define make-list
(lambda (x)
(reverse (make-listx 2 x '() ))))
MAKE-LIST
(define range
(lambda (x)
(reverse (make-listx 0 x '() ))))
RANGE
(define newlines
(lambda (x)
(map newline (range x))
'ok ))
NEWLINES
(define sq (make-list 200))
SQ
(define main
(lambda ()
(newlines 10)
(newline)
(print 'SBLisp ) (newline)
(print '------ ) (newline) (newline)
(print 'List= )
(print sq)
(newline)
(newline)
(print '"Filtering primes by mapping")
(newline)
(let (( res (map prime? sq)))
(print res)
(newline)
(print '....finished )
(print '..... )
)))
MAIN
(main)
SBLISP
------
LIST=(2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199)
FILTERING PRIMES BY MAPPING
(2 3 0 5 0 7 0 0 0 11 0 13 0 0 0 17 0 19 0 0 0 23 0 0 0 0 0 29 0 31 0 0 0 0 0 37 0 0 0 41 0 43 0 0 0 47 0 0 0 0 0 53 0 0 0 0 0 59 0 61 0 0 0 0 0 67 0 0 0 71 0 73 0 0 0 0 0 79 0 0 0 83 0 0 0 0 0 89 0 0 0 0 0 0 0 97 0 0 0 101 0 103 0 0 0 107 0 109 0 0 0 113 0 0 0 0 0 0 0 0 0 0 0 0 0 127 0 0 0 131 0 0 0 0 0 137 0 139 0 0 0 0 0 0 0 0 0 149 0 151 0 0 0 0 0 157 0 0 0 0 0 163 0 0 0 167 0 0 0 0 0 173 0 0 0 0 0 179 0 181 0 0 0 0 0 0 0 0 0 191 0 193 0 0 0 197 0 199)
....FINISHED..........
T
0]
Et voilà , messieurs ... ... the "iterator"Your achievements are simply amazing! I can't wait to see the ASCII Mandelbrot running in my XBLisp console too. :D
.............................................
addendum -- added 006 which does proper printing too.
Nice to see this thing actually working. 8)Thank you for your kind words. My eagerness to go on with this project has doubled now that you're emitting usable code for it. :)
the source is it QB ?? -- can't you wring/wrench it through something as QB64 / FB to give it more speed ??The (inoperative) original was written in QB4.5. But having it as yet another standalone LISP is not the main goal of this project. The milestones are:
Don't complain. You're getting major action in the commit comments. :P... which doesn't however justify your adultery with ECL in the meantime. :P
Here is Debian noroot running on my Samsung Galaxy Tab 2 10.1 tablet.Looks nice and very Linux-like. :)
Is it auto-GC , or do I have to code it ????
it has (silent .... ) if included in the source then it outputs nothing to the console.I like this very much. What do the periods .... here stand for? Can you give an example, please?
on an error there should always be a kind of indication what/where 's happeningThat's exactly what's there in XBLisp now. Error reports are always active but if e.g. a file with an illegal line break character is being loaded in a usual way, then the report will look like the following:
P.S. Or we can also add SBL_LoadLispFromMemory(stringtoload$) functionality easily on the XBLisp side of the interface and provide this function on the SB/FBSL side of it.
The reason for the "non-standard" flow is to implement proper tail
calls. The BASIC code is written in a style similar to assembly
language... If Script BASIC is properly tail recursive, then it should be
possible to change the code.
(On errors, I attempt to clear the BASIC subroutine stack manually.)
I don't have that much time to work on the new implementation, but I can
tell you why I wrote the code the way I did.
Just make sure you don't break proper tail calling.
I'll send you some Scheme code that should work without blowing the
stack.
I hope you won't be feeling overly lonely while I'm away.
(define (A m n)
(cond
((= m 0) (+ n 1))
((= n 0) (A (- m 1) 1))
(else (A (- m 1) (A m (- n 1))))))
It may not be immediately obvious that the evaluation of A(m, n) always terminates. However, the recursion is bounded because in each recursive application either m decreases, or m remains the same and n decreases. Each time that n reaches zero, m decreases, so m eventually reaches zero as well. (Expressed more technically, in each case the pair (m, n) decreases in the lexicographic order on pairs, which is a well-ordering, just like the ordering of single non-negative integers; this means one cannot go down in the ordering infinitely many times in succession.) However, when m decreases there is no upper bound on how much n can increase — and it will often increase greatly.
#include <stdio.h>
#include "cbasic.h"
FUNCTION int ackermann(int m, int n)
BEGIN_FUNCTION
IF (NOT m) THEN_DO RETURN_FUNCTION(n + 1);
IF (NOT n) THEN_DO RETURN_FUNCTION(ackermann(m - 1, 1));
RETURN_FUNCTION(ackermann(m - 1, ackermann(m, n - 1)));
END_FUNCTION
MAIN
BEGIN_FUNCTION
DIM AS int m, n;
DEF_FOR (m = 0 TO m <= 4 STEP INCR m)
BEGIN_FOR
DEF_FOR (n = 0 TO n < 6 - m STEP INCR n)
BEGIN_FOR
PRINT ("A(%d, %d) = %d\n", m, n, ackermann(m, n));
NEXT
NEXT
RETURN_FUNCTION(0);
END_FUNCTION
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
int m_bits, n_bits;
int *cache;
int ackermann(int m, int n)
{
int idx, res;
if (!m) return n + 1;
if (n >= 1<<n_bits) {
printf("%d, %d\n", m, n);
idx = 0;
} else {
idx = (m << n_bits) + n;
if (cache[idx]) return cache[idx];
}
if (!n) res = ackermann(m - 1, 1);
else res = ackermann(m - 1, ackermann(m, n - 1));
if (idx) cache[idx] = res;
return res;
}
int main()
{
int m, n;
m_bits = 3;
n_bits = 20; /* can save n values up to 2**20 - 1, that's 1 meg */
cache = malloc(sizeof(int) * (1 << (m_bits + n_bits)));
memset(cache, 0, sizeof(int) * (1 << (m_bits + n_bits)));
for (m = 0; m <= 4; m++)
for (n = 0; n < 6 - m; n++)
printf("A(%d, %d) = %d\n", m, n, ackermann(m, n));
return 0;
}
' Script BASIC Ackermann
function shifts(v,p,ar)
local bp,ba,co,cq,bi,x,y,d
bp=1
x=0xffffffff and v
for co=0 to 31
ba[co]=0
next
for co=0 to 31
bi=x and bp
cq=co+p
if (bi<>0) then
if ((cq>=0)and(cq<32)) then
ba[cq]=1
end if
end if
bp = bp + bp
next
bp=1
y=0
'
' SUPPORT FOR ARITHMETIC RIGHT SHIFTS
'
d=100
if (ar) then
if (x and 0x80000000) then
d=31+p
end if
end if
'
for co=0 to 31
if ((ba[co]<>0)or(co>=d)) then
y=y or bp
end if
bp = bp + bp
next
shifts=y
end function
' PRINT shifts(0x80000000,2),"\n"
' PRINT shifts(-32,-2,1),"\n"
' PRINT shifts(8,-2),"\n"
FUNCTION ackermann(m, n)
IF NOT m THEN ackermann = n + 1
IF n >= shifts(1, -n_bits) THEN
idx = 0
ELSE
idx = shifts(m, n_bits) + n
IF cache[idx] THEN ackermann = cache[idx]
END IF
IF NOT n THEN
res = ackermann(m - 1, 1)
ELSE
res = ackermann(m - 1, ackermann(m, n - 1))
END IF
IF cache[idx] = res THEN ackermann = res
END FUNCTION
m_bits = 3
n_bits = 20
SPLITA STRING(1048576,"") BY "" TO cache
FOR m = 0 TO 1
FOR n = 0 TO 3 - m
PRINT "A(",m," , ",n,") = ", ackermann(m, n),"\n"
NEXT
NEXT
'http://en.wikipedia.org/wiki/Ackermann_function
'
function Ack(sys m,n) as sys
sys t
if m>0 then
if n>0 then
t=Ack(m,n-1)
return Ack(m-1,t)
else
return Ack(m-1,1)
end if
else
return n+1
end if
end function
/*
( let ack " m n
(if (> m 0 )
(if (> n 0)
(eval
(decr m)
(decr n)
(let t (ack n 1))
(ack m t)
)
;else n=0
(eval
(decr m)
(ack m 1)
)
)
;else m=0
(+ n 1)
) ;end if m>0
")
*/
The non-recursive Ackermann seems an ugly beast. Is there any benefit in porting it?
' Ackermann
FUNCTION Ack(m, n)
IF m > 0 THEN
IF n > 0 THEN
t = Ack(m, n - 1)
Ack = Ack(m - 1, t)
ELSE
Ack = Ack(m - 1, 1)
END IF
ELSE
Ack = n + 1
END IF
END FUNCTION
FOR m = 0 TO 3
FOR n = 0 TO 3
PRINT "A(",m,",",n,") = ",Ack(m, n),"\n"
NEXT
NEXT
;;; Rob's macros
(define make-listx
(lambda (i x L)
(if (= i x) L
(make-listx (+ i 1) x (cons i L)))))
(define range
(lambda (x)
(reverse (make-listx 0 x '() ))))
(define iterate
(lambda (op it)
(map (eval op) (range it))
T ))
;;; ======= My LISP program ======
;; Define iterators
(define m 0)
(define n 0)
;; John's recursive Ackermann algo redefined
(define A
(lambda (x y)
(cond
((= x 0) (+ y 1))
((= y 0) (A (- x 1) 1))
(else
(A (- x 1) (A x (- y 1)))
)
)
)
)
;; My Ackermann call
(define Ackermann
(lambda ()
(print '"A(") (print m)
(print '", ") (print n)
(print '") = ") (print (A m n))
(newline)
(set! n (+ n 1))
)
)
(define for-inner
(lambda ()
(set! n 0)
(iterate 'ackermann (- 6 m))
(set! m (+ m 1))
)
)
(define for-outer
(lambda ()
(iterate 'for-inner 4)
)
)
(define main
(lambda ()
(iterate 'newline 10)
(print '========================== ) (newline)
(print '"My First XBLisp Program :)") (newline)
(print '========================== ) (newline) (newline)
(for-outer)
)
)
(main)
(quit)
;;; ==== THAT'S ALL FOLKS! ====
jrs@laptop:~/sb/sb22/sblisp$ time scriba lisp.sb ackermann.scm
SBLisp - Scheme BASIC Lisp
(define make-listx
(lambda (i x L)
(if (= i x) L
(make-listx (+ i 1) x (cons i L)))))
MAKE-LISTX
(define range
(lambda (x)
(reverse (make-listx 0 x '() ))))
RANGE
(define iterate
(lambda (op it)
(map (eval op) (range it))
T ))
ITERATE
(define m 0)
M
(define n 0)
N
(define A
(lambda (x y)
(cond
((= x 0) (+ y 1))
((= y 0) (A (- x 1) 1))
(else
(A (- x 1) (A x (- y 1)))
)
)
)
)
A
(define Ackermann
(lambda ()
(print '"A(") (print m)
(print '", ") (print n)
(print '") = ") (print (A m n))
(newline)
(set! n (+ n 1))
)
)
ACKERMANN
(define for-inner
(lambda ()
(set! n 0)
(iterate 'ackermann (- 6 m))
(set! m (+ m 1))
)
)
FOR-INNER
(define for-outer
(lambda ()
(iterate 'for-inner 4)
)
)
FOR-OUTER
(define main
(lambda ()
(iterate 'newline 4)
(print '=================== ) (newline)
(print '"Ackermann - SBLisp") (newline)
(print '=================== ) (newline) (newline)
(for-outer)
)
)
MAIN
(main)
===================
ACKERMANN - SBLISP
===================
A(0, 0) = 1
A(0, 1) = 2
A(0, 2) = 3
A(0, 3) = 4
A(0, 4) = 5
A(0, 5) = 6
A(1, 0) = 2
A(1, 1) = 3
A(1, 2) = 4
A(1, 3) = 5
A(1, 4) = 6
A(2, 0) = 3
A(2, 1) = 5
A(2, 2) = 7
A(2, 3) = 9
A(3, 0) = 5
A(3, 1) = 13
A(3, 2) = 29
T
(quit)
real 0m1.133s
user 0m1.116s
sys 0m0.012s
jrs@laptop:~/sb/sb22/sblisp$
Dear John,
> Mike Wrote:
>
> There is absolutely no functionality whatsoever implemented in this QB
> 4.5 code that would allow the *QB program stack* to be restored in case
> Lisp-in-Basic hits an error while one of its many recursive GoSub's is
> in deep recursion into itself, its siblings and children, and its parent
> such as LispPrint or especially LispEval into the bargain.
Ah, but there is: return. If you look for the label ClearStackLoop in the
original code, you'll see that it repeatedly returns. That is the point,
to clear the stack. The variable BSD stands for Basic Stack Depth.
-Arthur
==============================================================
Arthur Nunes-Harwitt
Computer Science Department, Rochester Institute of Technology
jrs@laptop:~/sb/sb22/sblisp$ time scriba lisp.sb rob_zeta.scm
SBLisp - Scheme BASIC Lisp
(define 1+
(lambda (x) (+ 1 x)))
1+
(define 1-
(lambda (x) (- x 1)))
1-
(define println
(lambda (s)
(print s) (newline)))
PRINTLN
(define make-listx
(lambda (i x L)
(if (= i x) L
(make-listx (+ i 1) x (cons i L)))))
MAKE-LISTX
(define range
(lambda (x)
(reverse (make-listx 0 x '() ))))
RANGE
(define iterate
(lambda (op it)
(map (eval op) (range it))
T ))
ITERATE
(define seq
(lambda (x)
(reverse (make-listx 1 (1+ x) '() ))))
SEQ
(define 3eta-1
(lambda (x)
(apply + (map (lambda (x) (/ 1 x)) (seq x)))))
3ETA-1
(define print3
(lambda (x)
(print (3eta-1 x))
(newline)))
PRINT3
(define tst
(lambda (x)
(map print3 (seq x)) T ))
TST
(define main
(lambda()
(iterate 'newline 10)
(println '"First 50 iterations of Zeta(1)")
(println '"-------------------------------")
(println '" ")
(println '"without memoizing things !")
(newline)
(tst 50)
(newline)
(println '"........finished.........")
))
MAIN
(main)
FIRST 50 ITERATIONS OF ZETA(1)
-------------------------------
WITHOUT MEMOIZING THINGS !
1
1.500000
1.833333
2.083333
2.283333
2.450000
2.592857
2.717857
2.828968
2.928968
3.019877
3.103211
3.180134
3.251562
3.318229
3.380729
3.439553
3.495108
3.547740
3.597740
3.645359
3.690813
3.734292
3.775958
3.815958
3.854420
3.891457
3.927171
3.961654
3.994987
4.027245
4.058495
4.088798
4.118210
4.146781
4.174559
4.201586
4.227902
4.253543
4.278543
4.302933
4.326743
4.349999
4.372726
4.394948
4.416687
4.437964
4.458797
4.479205
4.499205
........FINISHED.........
T
(quit)
real 0m2.505s
user 0m2.468s
sys 0m0.028s
jrs@laptop:~/sb/sb22/sblisp$
What optimizations are you using in your stock GCC, John?
function AckA(sys m,n) as sys
return call A m,n
.A
mov ecx,[esp+4] 'm
mov edx,[esp+8] 'n
(
cmp ecx,0
jg exit 'm>0 skip
inc edx 'n+1
mov eax,edx 'ret n+`
ret 8
)
(
cmp edx,0 '
jg exit 'n>0 skip
dec ecx 'm-1
call A ecx,1 'm-1,1
ret 8
)
dec edx 'm,n-1
call A ecx,edx 't
mov ecx,[esp+4] 'm reload
dec ecx 'm-1
call A ecx,eax ' m-1, t
ret 8
end function
AckA 4,1 '65533
Concerning "GOTO to another GOSUB", it wouldn't be a proper vision of the problem. You may not goto to another sub freely while in recursion. For you to have the right to goto, the both ends of the jump must be at the same recursion depth level or the stack will get disbalanced sooner or later, which will end up in an inevitable crash.
I confirm Mike's timing with o2 asm.
(loop for i from 1.0 to 3.0 by 0.5 do (print i))
function AckB(sys m,n) as sys
mov ecx,m
mov edx,n
return call A
.A
(
cmp ecx,0
jg exit 'm>0 skip
inc edx 'n+1
mov eax,edx 'ret n+1
ret
)
(
cmp edx,0 '
jg exit 'n>0 skip
dec ecx 'm-1
mov edx,1
call A 'A m-1,1
ret
)
dec edx 'm,n-1
push ecx 'save m
call A 't
pop ecx 'm reload
dec ecx 'm-1
mov edx,eax
call A 'A m-1, t
ret
end function
AckB 4,1 '65533
How would I do this in SBLisp?Code: [Select](loop for i from 1.0 to 3.0 by 0.5 do (print i))
; ===================================
;;; Rob's macros
; ===================================
(define make-listx
(lambda (i x L)
(if (= i x) L
(make-listx (+ i 1) x (cons i L)))))
(define range
(lambda (x)
(reverse (make-listx 0 x '() ))))
(define iterate
(lambda (op it)
(map (eval op) (range it))
T ))
(define println
(lambda (s)
(print s) (newline)))
; ===================================
;;; My FOR/TO/STEP/EXEC-COMMAND macro
; ===================================
(define iter 0)
(define step 0)
(define comm 0)
(define exec-for
(lambda ()
(comm)
(set! iter (+ iter step))
)
)
(define for
(lambda (f u s c)
(set! iter f) (set! step s) (set! comm c)
(iterate 'exec-for (floor (+ (/ (- u f) s) 1)))
)
)
; ===================================
; NB: ITER is the name reserved above for the FOR iterator
(define print-i (lambda () (println iter))) ; define what we want to do
(for 1 3 0.5 print-i) ; do it
maybe I should make a generalisation (index start end step) .Great! You'll become John's hero if you do. :)
QuoteConcerning "GOTO to another GOSUB", it wouldn't be a proper vision of the problem. You may not goto to another sub freely while in recursion. For you to have the right to goto, the both ends of the jump must be at the same recursion depth level or the stack will get disbalanced sooner or later, which will end up in an inevitable crash.
I'm confused. Are you speaking of SBLisp's stack or Script BASIC's stack?
Optimised Recursive Ackermann ( o2 asm)
reduces use of stack:
'RESTORE STACK POINTER AFTER RECURSIVE GOSUB
function f()
============
sys i
sys fsp=esp 'RECORD STACK POINTER VALUE HERE
gosub sa
return
sa:
while i<10
i++
call sa 'BUILD RECURSION
wend
esp=fsp 'RESTORE STACK POINTER (optional!)
goto sb
...
sb:
print "ok"
end function
f()
There will be no more updates to the lisp.sb from me and all my further activities will be focused on FBLisp only.
/oups ...my fault ,,i have started this topic ::) /
Cool Aurel, you have courage. :)
I hope they do not bite you!. You started a dangerous attempt.
which gives the nth element of a List (beware indexbase 0)I guess we wouldn't be able to recreate the ASCII Mandelbrot code in XBLisp without this operator.
maybe something can be done with pre-declared global variables -- but it looks ugly to define some things for functions/procedures that are pre-codedExactly! I didn't like the three predefined global vars that I used in my (for) solution but I couldn't figure out how I could pass in the variable that the iterator should have used for incrementation.
I suggest temp_num and temp_str in the SB code.
Entia non sunt multiplicanda praeter necessitatem
(Entities must not be multiplied beyond necessity)
However, the stack may also be explicitly managed thus:
def RetLabel add esp,4 : goto %1
sys i
gosub sa
print "ok main"
end
sa:
if i=0 then RetLabel bb
ret
bb:
print "ok bb"
PS: source of Rob's anecdote
Another classic macro-writing macro is once-only,
(defmacro do-primes ((var start end) &body body)
(once-only (start end)
`(do ((,var (next-prime ,start) (next-prime (1+ ,var))))
((> ,var ,end))
,@body)))
... the name of the proof of concept project ... maybe you can go with what is already establishedThis is not an established fact to me. Had I considered the repo as the center of this project's activities, I would have confined mine to it. Instead you're seeing me active in this terrifically entertaining thread and you had my assurances that I wasn't even pretending to have my name included in the list of SBLisp acknowledgments.
I would like to see OxygenBasic be the project language being used in it's traditional BASIC format.It will be so as soon as I see the BASIC LISP structure finalized. Then I will be able to select, with Charles assistance of course, the Oxygen means and features most appropriate for the final layout of this project in its BASIC notation.
I would still like get this into an either a SB BASIC MODULE or a SB C ext. module using C BASIC. Without your input and help, I have better things to do.With or without your participation, I will have the SB implementation finalized together with the other two. It will be fine with me if then you can make use of my output to the benefit of SB. Neither will it be a tragedy if you can't or wouldn't.
It could be implemented for o2 programs like this:
I'm rather concerned that a language enforces the use of recursion, ...
If Script BASIC is properly tail recursive, then it should be possible to change the code.
I'm rather concerned that a language enforces the use of recursion, by not supporting iteration and other loops. Cyclical processes are fundamental in this universe, and also in mathematical procedures too :)
We haven't yet reached the stage where the mighty potential of Oxygen's inline assembly will enhance the basic prototype at its most crucial points.
... it would be worth the effort to use PBCC 5 ...I don't own a PB. I'm out on this project fork.
nothing more than as an updated QB referenceThis is a deadly mistake. QB45 uses variants like SB and FBSL. PB and O2 use strongly typed variables.
I almost wish I didn't remove the optional $ symbol in the SB version. The % and other numeric type symbols aren't supported in SB.This won't help you any. BASIC LISP uses common variant arrays to store integer and floating-point numbers. Moreover, it uses its temporary "registers" pvalue, qvalue, etc. to store the same plus strings that go into the hash table at the program initialization stage.
PB and O2 use strongly typed variables.
O2 variables are strong but supple!
Can you give me a practical example of storing both integers and doubles in a common O2 array, and integers, doubles and strings in a variable called pvalue, without the need to maintain an auxilliary array that would concurrently store the values' data types, please?
I will try to conjure an example after my dawn siesta :)
Be aware as Charles and I discovered you can't directly assign a SB string pointer.
Be aware as Charles and I discovered you can't directly assign a SB string pointer.
1. Can you get a pointer to anything in SB without Charles' extension module? I'm aware of ADDRESSOF and associated FUNCALL -- what about pointers to SB variables in general?
2. Is Charles' extension module a prerequisite for SB to be able to communicate with any other precompiled extension module e.g. graphics?
I haven't seen the FBSL version of the SBLisp project since the beginning. What is the current format? Does it look more like the original QB version or the SB version?
If all you need is a simple FFI use the DYC ext. module from SB.
Thank you. Does SB use the concept of pointers at all except in its ref variables and indirect function calls with FUNCALL? In other words, can you get a pointer to anything in SB with an operator and then do something useful with such a pointer further on in your code?
ADDRESS returns an internal SB serial number for the function which then can be used with other SB BASIC functions and passed as an argument for indirect calls from within the function. Argument count may vary and tested at the SB API level. The SB extension & embedding API is the only way to deal with the SB internals.
Okay. I pushed your source and Windows executable to the FBSL folder on Bitbucket.
Now please undo.
'AUTOCONVERSION
string s[100]
double d1,d2,d3
'no conversion needed
s[1]=4.25
s[2]=1.25
s[3]="10"
'transfer to doubles for direct arith expression
================================================
d1=s[1]
d2=s[2]
d3=s[3]
s[4]="Total: "+d1+d2+d3
print s[4] 'Total 15.5
'using autoconversion in function parameters
============================================
function sum(optional double n1,n2,n3,n4) as double
return n1+n2+n3+n4
end function
s[4]=sum s[1],s[2],s[3]
print s[4] '15.5
"Just because it is possible to push a pea up a mountain with your nose does not mean it is a sensible way";D
Aurel,
Re: PWCT: th power is in the IDE, I think.
I would like to say that i prefer to believe in new languages like is PWCT than in this hybrid basic-lisp.
This example indicates what is possible with o2 autoconversion, instead of using explicit conversion, or variants.
[EDIT] Will Oxygen's string functions, for example STR(), handle the elements of such an array as s[n] in you example correctly? Is garbage collection solid when re-assigning string/double/string/double/... values to the array elements?
PWCT is a Lego for script kiddies, a VB6 IDE promoted to the nth power of absurdity
It's all in my head -- should I code it -- resulting exec time may be very long...
Can you post the top 5 SBLisp SUB/FUNCTION routines that would best be served by a C conversion?
please don't rush me.
Wow! Getting rid of BSD is something.
Lets not call it XBlisp any longer and lets call it BASIC Lisp.Whatever as long as it isn't called SBLisp here. Sounds too confusing to me.
O2 Forum Activity - 1 YearHaven't I brought along a couple of K's since registered? ;)
I don't think Mike would be spending the time on this and using a rivals BASIC...We are neither rivals nor competitors. For me, SB is just another BASIC like O2 or thinBasic among those that can interest me to the extent of actually coding something in them.
Haven't I brought along a couple of K's since registered?
I mean things like the modulus is missing and also the squareroot ...
QuoteI mean things like the modulus is missing and also the squareroot ...Please don't waste your time with defining math functions. These are VERY easy to add to BL. (BASIC functions providing the juice)
' Given the starting value of 34 degrees, calculate radians.
' Given the radian value, calculate TAN, COTAN, SECANT and COSECANT.
' Given the TAN, COTAN, SECANT and COSECANT values,
' calculate the ATAN, ACTAN, ASECANT and ACOSECANT.
'
degval = 34
radval = RAD(degval)
zerval = 0
tanval = TAN(radval)
cotval = COTAN(radval)
secval = SECANT(radval)
cseval = COSECANT(radval)
ataval = ATAN(tanval)
actval = ACTAN(cotval)
aseval = ASECANT(secval)
acoval = ACOSECANT(cseval)
hsinv = HSIN(radval)
hcosv = HCOS(radval)
htanv = HTAN(radval)
hsecv = HSECANT(radval)
hcosc = HCOSECANT(radval)
hcotv = HCTAN(radval)
print "\nThe following 8 functions accept radians as their argument, so we "
print "use the\nnew RAD() function to convert ",degval," degrees to ",radval," (",str$(radval),") radians.\n\n"
print "Tangent\t\tCotangent\tSecant\t\tCosecant\n"
print "TAN() \t\tCOTAN() \tSECANT() \tCOSECANT()\n"
print tanval," \t",cotval,"\t",secval," \t",cseval,"\n"
print str$(tanval)," \t",str$(cotval)," \t",str$(secval)," \t",str$(cseval),"\n\n"
print "Arctangent\tArccotangent\tArcsecant\tArccosecant\n"
print "ATAN() \tACTAN() \tASECANT()\tACOSECANT()\n"
print ataval," \t",actval," \t",aseval," \t",acoval,"\n"
print str$(ataval)," \t",str$(actval)," \t",str$(aseval)," \t",str$(acoval),"\n\n"
print "There are 6 Hyperbolic functions. They also accept radian arguments.\n\n"
print "H-Sine\t\tH-Cosine\tH-Tangent\n"
print "HSIN()\t\tHCOS() \tHTAN()\n"
print hsinv," \t",hcosv," \t",htanv,"\n"
print str$(hsinv)," \t",str$(hcosv)," \t",str$(htanv),"\n\n"
print "H-Secant\tH-Cosecant\tH-Cotangent\n"
print "HSECANT()\tHCOSECANT()\tHCTAN()\n"
print hsecv," \t",hcosc," \t",hcotv,"\n"
print str$(hsecv)," \t",str$(hcosc)," \t",str$(hcotv),"\n\n"
jrs@laptop:~/sb/sb22/test$ scriba testmath.sb
The following 8 functions accept radians as their argument, so we use the
new RAD() function to convert 34 degrees to 5.934119e-01 (0.593412) radians.
Tangent Cotangent Secant Cosecant
TAN() COTAN() SECANT() COSECANT()
6.745085e-01 1.482561e+00 1.206218e+00 1.788292e+00
0.674509 1.482561 1.206218 1.788292
Arctangent Arccotangent Arcsecant Arccosecant
ATAN() ACTAN() ASECANT() ACOSECANT()
5.934119e-01 5.934119e-01 5.934119e-01 5.934119e-01
0.593412 0.593412 0.593412 0.593412
There are 6 Hyperbolic functions. They also accept radian arguments.
H-Sine H-Cosine H-Tangent
HSIN() HCOS() HTAN()
6.288574e-01 1.181297e+00 5.323451e-01
0.628857 1.181297 0.532345
H-Secant H-Cosecant H-Cotangent
HSECANT() HCOSECANT() HCTAN()
8.465274e-01 1.590186e+00 1.878481e+00
0.846527 1.590186 1.878481
jrs@laptop:~/sb/sb22/test$
// Conversion d'angles degrés <-> radians
{"degrees", r2d},
{"r2d", r2d},
{"radians", d2r},
{"d2r", d2r},
// Fonctions trigonométriques (versions radians = normal)
{"cos", cos},
{"cosec", cosec},
{"cotan", cotan},
{"sec", sec},
{"sin", sin},
{"tan", tan},
{"acos", acos},
{"acosec", acosec},
{"acotan", acotan},
{"asec", asec},
{"asin", asin},
{"atan", atan},
{"cosh", cosh},
{"cosech", cosech},
{"cotanh", cotanh},
{"sech", sech},
{"sinh", sinh},
{"tanh", tanh},
{"acosh", __acosh},
{"acosech", acosech},
{"acotanh", acotanh},
{"asech", asech},
{"asinh", __asinh},
{"atanh", __atanh},
// Autres notations (~VB) :
{"atn", atan},
{"cosin", cos},
{"sinus", sin},
{"tgn", tan},
{"arccos", acos},
{"arccosec", acosec},
{"arccotan", acotan},
{"arcsec", asec},
{"arcsin", asin},
{"arctan", atan},
{"hcos", cosh},
{"hcosec", cosech},
{"hcotan", cotanh},
{"hsec", sech},
{"hsin", sinh},
{"htan", tanh},
{"harccos", __acosh},
{"harccosec", acosech},
{"harccotan", acotanh},
{"harcsec", asech},
{"harcsin", __asinh},
{"harctan", __atanh},
// Version degrés (pas toutes) :
{"cosd", cosd},
{"cosecd", cosecd},
{"cotand", cotand},
{"secd", secd},
{"sind", sind},
{"tand", tand},
{"acosd", acosd},
{"asind", asind},
{"atand", atand},
// Autres notations (degrés) :
{"arccosd", acosd},
{"arcsind", asind},
{"arctand", atand},
// Notations V2 :
{"ctnd", cotand},
{"secd", secd},
{"cscd", cosecd},
// Fonctions de racines et puissances
{"sqrt", sqrt},
{"sqr", sqrt},
{"cbrt", __cbrt},
{"cbr", __cbrt},
{"square", square},
// voir aussi xrt, nrt, pow dans dbl_two
// Fonctions exponentielles et logarithmes
{"exp2", __exp2},
{"expm1", __expm1},
{"exp", exp},
{"ln", log},
{"log", log},
{"log10", log10},
{"log1p", __log1p},
{"log2", __log2},
{"logb", logb},
// voir aussi logx, logn dans dbl_two
// Fonctions d'arrondi
{"round", round},
{"ceil", ceil},
{"floor", floor},
{"nearbyint", nearbyint},
// Valeur absolue
{"abs", fabs},
{"fabs", fabs},
// Fonctions d'erreur
{"erf", erf},
{"erfc", erfc},
// Fonctions diverses
{"lgamma", lgamma}
// Autres
{"rnd", rnd}
{"rand", rand}
{"randint", randint}
{"atan2", atan2},
{"atn2", atan2},
{"arctan2", atan2},
{"logx", logx},
{"logn", logx},
{"xrt", xrt},
{"nrt", xrt},
{"pow", pow}
{"gcd", gcd}, // PGCD
{"scm", scm}, // PPCM
__f1("sgn", Sgn, 1),
__f1("min", MiN, 2),
__f1("max", MaX, 2),
__f1("min3", MiN3, 3),
__f1("max3", MaX3, 3)
Now what?
We aren't planning intensive math calc in BL at this stage, are we?
I'm writing a short report with my findings on the usability of Lisp-in-Basic code for the needs of SB, O2, and FBSL. I have tried many things, and I have failed many times. I want to discuss with you my vision of what we can do based on my trial and error.
Can we do this on the AllBASIC IRC instead?
Remark the difference with NewLisp , any CL , and probably any other Scheme
;;; finding if an element exists in that list
; (define exists-in?
; (lambda (ele lis)
; (cond ((null? lis) #f)
; ((equal? ele (car lis)) #t)
; (else (exists-in? ele (cdr lis)))
; )
; )
; )
;;; 'mapping' each element of the list to some value
(define plustwo
(lambda (lis)
(cond ((null? lis) nil)
(else (cons (+ (car lis) 2)
(plustwo (cdr lis)))
)
)
)
)
;;; 'fold up' a list of such values into a single value
(define foldr
(lambda (f e lis)
(cond ((null? lis) e)
(else (f (car lis) (foldr f e (cdr lis))))
)
)
)
;;; use this folding function to define a function called any
(define any
(lambda (pred lis)
(foldr (lambda (x acc) (or x acc))
#f
(map pred lis)
)
)
)
;;; Using this function we can re-write exists-in?
(define exists-in?
(lambda (ele lis)
(any (lambda (x) (equal? x ele)) lis)
)
)
...........
(foldr (lambda (x acc) (or x acc))
#f ; <== probably wrong and should BE (), which is BL's symbol for FALSE
(map pred lis)
)
.............
wouldn't be correct and would throw an exception at run time. In fact, you haven't changed the grammar for FALSE, you only made BL print F instead of () to the console. But BL wouldn't recognise F as a valid input for FALSE.
:-\ I had a bad feeling about changing that. Please put it back the way it was.
"1. Show me the Scheme that has looping in it. I want to see its commands and their syntax."
I gave you a link to the official r5rs Standard - (attached) ,
I also asked you what "a pure Scheme" means : is it the one of Sussman and Steel (?) , the original or what ? you did not answer and If you have those documents, please give the links and I will read these.
2. I will add the looping only based on what I will see in at least one such Scheme available on the net.
ANY scheme I know has "named let" :
------------------------------------
"Named `let'" is a variant on the syntax of let which provides a more general looping construct than `do'....Quote from: Mike@Rob:
Thanks for reminding me about (do). In fact I'm keeping it in mind. I'm simply waiting for when John finds a little time to get acquainted with the Scheme vocabulary to tell me that there's no (print) in there but rather (display), and that there's not only (for-each) in there but also (do)
Scheme has no while-loops or for-loops. In Scheme a similar effect is achieved by simply letting a function call itself.
Scheme is very odd in one sense, it has no expressions designed for looping, repeating or otherwise doing something more than once at a general level.
... whenever a function calls itself in such a way that the same effect can be implemented by a loop or iteration, Scheme guarantees that the compiler will rewrite it to a loop at the machine-code level, so you will never run out of stack space or need useless time to call procedures when what you try to do can be rewritten to a loop ...
It may be the pure no-library "syntax" refers to the original Sussman / Steel / etc experiment which I think contained no loop mechanism and in those days was named Schemer - but personally I never would use such , unless in a masochistic mood.
Quote... whenever a function calls itself in such a way that the same effect can be implemented by a loop or iteration, Scheme guarantees that the compiler will rewrite it to a loop at the machine-code level, so you will never run out of stack space or need useless time to call procedures when what you try to do can be rewritten to a loop ...Mike:
(Rob and Charles, I wonder what the algorithm may look like to programmaticaly analyze a Scheme recursive procedure and unroll/fix/recode it automatically into a loop?)
'TAIL RECURSION
===============
function fibo(m,n,c) as string
if c
return n+" "+fibo(n,m+n,c-1)
end if
end function
'TRANSLATE TO LOOP
==================
function fibo(m,n,c) as string
recur:
if c
'PARAM SETTING
tc=c-1 : tn=m+n : tm=n
m=tm : n=tn : c=tc
function += n+" "
goto recur
end if
end function
print fibo 1,1,10
jrs@laptop:~/sb/sb22/sblisp/Rob$ time scriba lisp.sb asciiM.bl
SBLisp - Scheme BASIC Lisp
(define grid '())
GRID
(define mapped-grid '())
MAPPED-GRID
(define modulus
(lambda (n d)
(let (( r (floor (/ n d))))
(- n (* r d)))))
MODULUS
(define cadr
(lambda (L)
(car (cdr L))))
CADR
(define sqrt
(lambda (x)
(exp (/ (log x) 2))))
SQRT
(define sq (lambda(x) (* x x)))
SQ
(define 1- (lambda (x) (- x 1)))
1-
(define 1+ (lambda (x) (+ x 1)))
1+
(define level
(lambda (i x y rc ic it orb)
(if (or (= i it) (> orb 4)) i
(level (1+ i) (+ rc (- (sq x) (sq y))) (+ ic (* 2 x y)) rc ic it (+ (sq x) (sq y))))))
LEVEL
(define mlevel
(lambda (L)
(level 0 (cadr L) (car L) (cadr L) (car L) 11 0)))
MLEVEL
(define fill-grid
(lambda (nrx xo dx nry yo dy matrix dup)
(if (and (= 0 nrx) (= 0 nry)) matrix
(if (= 0 nry) (fill-grid (1- nrx) xo dx dup yo dy matrix dup)
(fill-grid nrx xo dx (1- nry) yo dy
(cons (list (+ xo (* nrx dx)) (+ yo (* nry dy))) matrix) dup)))))
FILL-GRID
(define square-grid
(lambda (nr x y dz)
(fill-grid (1- nr) (+ x dz) dz nr y dz '() nr)))
SQUARE-GRID
(define map-grid
(lambda (L)
(map mlevel L)))
MAP-GRID
(define print*
(lambda (x)
(if (> x 9)
(print x)
(sequence (print x) (print '" ")) )))
PRINT*
(define print-grid
(lambda (i it L)
(if (null? L) T
(if (= i it) (sequence (print* (car L)) (newline) (print-grid 0 it L))
(sequence (print* (car L)) (print-grid (1+ i) it (cdr L)))))))
PRINT-GRID
(define main
(lambda ()
(set! grid (square-grid 30 -1.7 -2.3 0.1))
(set! mapped-grid (map-grid grid))
(print-grid 0 30 mapped-grid)
))
MAIN
(main)
1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1
1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1
1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1
1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 1
1 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 1
1 1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 115 4 4 3 3 2 2 2 2 1
1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 5 7 9 114 4 3 3 2 2 2 1
1 1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 9 118 5 4 4 3 3 3 2 1
1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 8 1111116 5 5 4 3 3 3 1
1 1 1 1 2 3 3 3 3 3 3 3 4 4 4 5 7 8 8 101111119 6 6 5 4 3 3 1
1 1 1 2 3 3 3 3 3 3 3 4 4 5 5 6 11111111111111111111114 3 3 1
1 1 1 2 3 3 3 3 3 4 5 5 5 5 6 8 111111111111111111117 5 3 3 1
1 1 1 3 3 3 3 4 5 7 7 7 7 7 7 11111111111111111111119 5 4 3 1
1 1 1 3 4 4 4 5 5 7 111111119 1111111111111111111111116 4 3 1
1 1 1 4 4 4 5 5 6 8 11111111111111111111111111111111115 4 3 1
1 1 1 4 4 6 6 7 1111111111111111111111111111111111118 5 4 3 1
1 1 1111111111111111111111111111111111111111111111117 5 4 3 1
1 1 1 4 4 6 6 7 1111111111111111111111111111111111118 5 4 3 1
1 1 1 4 4 4 5 5 6 8 11111111111111111111111111111111115 4 3 1
1 1 1 3 4 4 4 5 5 7 111111119 1111111111111111111111116 4 3 1
1 1 1 3 3 3 3 4 5 7 7 7 7 7 7 11111111111111111111119 5 4 3 1
1 1 1 2 3 3 3 3 3 4 5 5 5 5 6 8 111111111111111111117 5 3 3 1
1 1 1 2 3 3 3 3 3 3 3 4 4 5 5 6 11111111111111111111114 3 3 1
1 1 1 1 2 3 3 3 3 3 3 3 4 4 4 5 7 8 8 101111119 6 6 5 4 3 3 1
1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 8 1111116 5 5 4 3 3 3 1
1 1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 9 118 5 4 4 3 3 3 2 1
1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 5 7 9 114 4 3 3 2 2 2 1
1 1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 115 4 4 3 3 2 2 2 2 1
1 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 1
1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 T
(quit)
real 0m35.469s
user 0m35.406s
sys 0m0.028s
jrs@laptop:~/sb/sb22/sblisp/Rob$
Once a tail recursion is identified, set the params using temp variables as intermediates. Then goto start of the function's inner code body, accumulating the loop results.
(load-extension "tsx_mysql")
(display "Mysql extension test.")(newline)
(define queries (list
"SELECT VERSION(), CURRENT_DATE"
"SHOW DATABASES"
"SELECT table_name, table_type, engine FROM information_schema.tables"))
(define run-query
(lambda (sql)
(let ((result (mysql-query sql)))
(if result
(display result)
(display (mysql-error))))
(newline)))
(if (mysql-connect "" "" "" "")
(for-each run-query queries)
(display (mysql-error)))
(mysql-disconnect)
(newline)
I will post the FBSL sources here for examination ...
I'm just trying to follow along based on your mixed messages and demands.
Please let me know when you have a working SB version so I can update the repository and unfreeze the code.
'ORIGINAL
=========
function fiboR(m,n,c, string s) as string
if c
return n+" "+fiboR(n,m+n,c-1,s)
end if
end function
'TRANSLATE TO LOOP
==================
function fiboL(sys m,n,c, string _s) as string 'DECORATE DIRECT STRING PARAMS
'
bstring s=_s 'MAKE COPIES OF ALL DIRECT STRING PARAMS
bstring recurn 'RETURN VALUE (now a bstring)
recur: 'LOOP POINT
'START OF SOURCE FUNCTION BODY
if c '
recurn += n+" " 'ACCUMULATE RETURN VALUE (instead of return ...)
'
'PARAM SETTING (safe!)
tc=c-1 : tn=m+n '
tm=n : ts=s+"X" '
m=tm : n=tn '
c=tc : s=ts '
lea edi,[ebp-4] 'LOCAL GARBAGE COLLECTION LIST
call [ebx+2080] 'DELETE LOCAL STRINGS (RTL:delchain)
goto recur 'MAKE RECURSIVE LOOP
end if '
'END OF SOURCE FUNCTION BODY
frees s 'RELEASE ALL COPIES OF DIRECT STRING PARAMS
return recurn
end function
'print fiboR 1,1,10,"dummy"
print fiboL 1,1,10,"dummy"
A model for direct-string-safe tail-recursion:
0.3. There are over 550 instances of BSD (stack depth counter) incrementation throughout the code corresponding to GOSUB calls, and there will be an exact same amount of decrementations to keep the stack balanced. And all this in just one single cycle without going into any recursion or a nested call whatsoever. Going recursive will increase these numbers many times over. It means we will be executing many thousands of incrementations and decrementations over and over again for a slim chance of unlikely error in a piece of known working code. This will be a speed killer for any interpreter even if it runs compiled to machine code, e.g. like OxyLISP will.
This isn't however the case with SBLisp. It can't stay as is in this interpretative form as an include file because it will be too slow. So it must be re-written in C either directly or via CBASIC and compiled as a dynamic library extension. Then it will be able to communicate with its SB host via the same exec-from-memory mechanism but it will have to have its own intrinsic bindings to the other SB luxuries such as e.g. SB's IUP graphics.
Or SBLisp can stay as a CBASIC or C include file for C-based SB projects where SB is used as an embeddable engine. Then it could enjoy common resources, e.g. IUP graphics again, that have their bindings with such a C language based project as a whole.
I don't see any reason why it shouldn't or couldn't be done like that.
I'm here just to let you know that I'm safe and sound.
Mission accomplished : 8)
Thanks for the pdf Rob,
I'll look through it, perhaps it can give me ideas.
The following strategy can be used to the remove the recursion from a recursive routine, although not elegantly. There might be a far more pleasing method for a particular routine, but this technique is very instructional. It allows you simulate the system stack by declaring your own stack structure and manage the recursion. It is accomplished as follows:
i) Each time a recursive call is made in the algorithm, push the necessary information onto your stack.
ii) When you complete processing at this deeper level, pop the simulated stack frame and continue processing in the higher level at the point dictated by the return address popped from the stack.
iii) Use an iterative control structure that loops until there are no return addresses left to pop from the stack.
Strangely the NewLisp is very close to the original McCarthy Lisp of the end 1950sAre you really that ancient, Rob? :o
I think recursion->iteration can be simulated @ Lisp level too --Did you know that almost all existing LISP-to-C and LISP-to-Asm translators are actually written in LISP? Their source code is thus an order of magnitude shorter than its respective C or assembly analog. :)
I was born the eleventh year after the end of the Great War .. it was dark and snowing , that's all I remember
Is that a farewell from China?
QuoteIs that a farewell from China?Actually it was from an article about fashion statements in NY.
Faking happy when things aren't going as planned...
... in NYC? (that's a joke)
(but I'm not a Scheme specialist of course)
TinyScheme 1.41
ts> (define f (lambda (x i acc)
(if (zero? i) acc (f x (- i 1) (+ acc x)))))
f
ts> (define (tst x) (f x x 0))
tst
ts> (tst 5)
25 ; <===== IS THIS IT?
ts>
(define test (lambda (x)
(let ((f (lambda (i) (* i i))))
(f x))))
but f must be non-recursive ...
I need them very very badly. (and I'm currently interested only in OxyLISP (= Lisp-in-Basic) compatible code)
> (seq 1 22)Aha! So it constructs a list with values in the range of 1 to 22!
But did play with DISLIN a few times
; nanoscheme initialization file
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define (caaar x) (car (car (car x))))
(define (caadr x) (car (car (cdr x))))
(define (cadar x) (car (cdr (car x))))
(define (caddr x) (car (cdr (cdr x))))
(define (cdaar x) (cdr (car (car x))))
(define (cdadr x) (cdr (car (cdr x))))
(define (cddar x) (cdr (cdr (car x))))
(define (cdddr x) (cdr (cdr (cdr x))))
(define (caaaar x) (car (car (car (car x)))))
(define (caaadr x) (car (car (car (cdr x)))))
(define (caadar x) (car (car (cdr (car x)))))
(define (caaddr x) (car (car (cdr (cdr x)))))
(define (cadaar x) (car (cdr (car (car x)))))
(define (cadadr x) (car (cdr (car (cdr x)))))
(define (caddar x) (car (cdr (cdr (car x)))))
(define (cadddr x) (car (cdr (cdr (cdr x)))))
(define (cdaaar x) (cdr (car (car (car x)))))
(define (cdaadr x) (cdr (car (car (cdr x)))))
(define (cdadar x) (cdr (car (cdr (car x)))))
(define (cdaddr x) (cdr (car (cdr (cdr x)))))
(define (cddaar x) (cdr (cdr (car (car x)))))
(define (cddadr x) (cdr (cdr (car (cdr x)))))
(define (cdddar x) (cdr (cdr (cdr (car x)))))
(define (cddddr x) (cdr (cdr (cdr (cdr x)))))
(define call/cc call-with-current-continuation)
(define (list . x) x)
(define (map proc list)
(if (pair? list)
(cons (proc (car list)) (map proc (cdr list)))))
(define (for-each proc list)
(if (pair? list)
(begin (proc (car list)) (for-each proc (cdr list)))
#t ))
(define (list-tail x k)
(if (zero? k)
x
(list-tail (cdr x) (- k 1))))
(define (list-ref x k)
(car (list-tail x k)))
(define (last-pair x)
(if (pair? (cdr x))
(last-pair (cdr x))
x))
(define (head stream) (car stream))
(define (tail stream) (force (cdr stream)))
;; The following quasiquote macro is due to Eric S. Tiedemann.
;; Copyright 1988 by Eric S. Tiedemann; all rights reserved.
(macro
quasiquote
(lambda (l)
(define (mcons f l r)
(if (and (pair? r)
(eq? (car r) 'quote)
(eq? (car (cdr r)) (cdr f))
(pair? l)
(eq? (car l) 'quote)
(eq? (car (cdr l)) (car f)))
(list 'quote f)
(list 'cons l r)))
(define (mappend f l r)
(if (or (null? (cdr f))
(and (pair? r)
(eq? (car r) 'quote)
(eq? (car (cdr r)) '())))
l
(list 'append l r)))
(define (foo level form)
(cond ((not (pair? form)) (list 'quote form))
((eq? 'quasiquote (car form))
(mcons form ''quasiquote (foo (+ level 1) (cdr form))))
(#t (if (zero? level)
(cond ((eq? (car form) 'unquote) (car (cdr form)))
((eq? (car form) 'unquote-splicing)
(error "Unquote-splicing wasn't in a list:"
form))
((and (pair? (car form))
(eq? (car (car form)) 'unquote-splicing))
(mappend form (car (cdr (car form)))
(foo level (cdr form))))
(#t (mcons form (foo level (car form))
(foo level (cdr form)))))
(cond ((eq? (car form) 'unquote)
(mcons form ''unquote (foo (- level 1)
(cdr form))))
((eq? (car form) 'unquote-splicing)
(mcons form ''unquote-splicing
(foo (- level 1) (cdr form))))
(#t (mcons form (foo level (car form))
(foo level (cdr form)))))))))
(foo 0 (car (cdr l)))))
;; atom?
(define (atom? x)
(not (pair? x)))
;; memq
(define (memq obj lst)
(cond
((null? lst) #f)
((eq? obj (car lst)) lst)
(else (memq obj (cdr lst)))))
;; equal?
(define (equal? x y)
(if (pair? x)
(and (pair? y)
(equal? (car x) (car y))
(equal? (cdr x) (cdr y)))
(and (not (pair? y))
(eqv? x y))))
;; (do ((var init inc) ...) (endtest result ...) body ...)
;;
(macro do
(lambda (do-macro)
(apply (lambda (do vars endtest . body)
(let ((do-loop (gensym)))
`(letrec ((,do-loop
(lambda ,(map (lambda (x)
(if (pair? x) (car x) x))
`,vars)
(if ,(car endtest)
(begin ,@(cdr endtest))
(begin
,@body
(,do-loop
,@(map (lambda (x)
(cond
((not (pair? x)) x)
((< (length x) 3) (car x))
(else (car (cdr (cdr x))))))
`,vars)))))))
(,do-loop
,@(map (lambda (x)
(if (and (pair? x) (cdr x))
(car (cdr x))
nil))
`,vars)))))
do-macro)))
I will not disclose where I got the nanoscheme sources from.
Lets see if the KGB can make you talk. :-X
What would be the preferred TinyScheme syntax for passing a list to a BASIC array?
I want to interface it with Oxygen , there's no .. catch , throw I think ? -- how do I exit a 16 deep for next loop ????
exit for, for , for , for ... for (16x)
My question is what is going to be returned from TS in the list argument? A pointer to a C array/structure/... or a delimited string?
Yes, interfacing TinyScheme with SB seamlessly would require profound knowledge of C. It's up to you to decide if it's worth your effort.
I need to master SB internals before taking on any other languages that are a peripheral interest in my realm.
It pains me to see Rob stuggling with JAPI ...
I would gladly tear the arms and other extremities off of those (Java) developers whose product behaves like that on my machine.
VOID ExitProcess(
UINT uExitCode // exit code for all threads
);
BOOL TerminateProcess(
HANDLE hProcess, // handle to the process
UINT uExitCode // exit code for the process
);
! Function CreateToolhelp32Snapshot LIB "kernel32" (DWORD dwFlags, th32ProcessID) As DWORD
! Function Process32First LIB "kernel32" (DWORD hSnapshot, lppe) As Long
! Function Process32Next LIB "kernel32" (DWORD hSnapshot, lppe) As Long
! Function OpenProcess LIB "kernel32" (DWORD dwDesiredAccess, bInheritHandle, dwProcessId) As DWORD
! Sub TerminateProcess LIB "kernel32" (DWORD hProcess, uExitCode)
! Sub CloseHandle LIB "kernel32" (DWORD hObject)
Type PROCESSENTRY32
DWORD dwSize
DWORD cntUsage
DWORD th32ProcessID
DWORD th32DefaultHeapID
DWORD th32ModuleID
DWORD cntThreads
DWORD th32ParentProcessID
Long pcPriClassBase
DWORD dwFlags
Char szExeFile[260]
End Type
Const TH32CS_SNAPALL = 0xF
Const PROCESS_TERMINATE = 0x1
Dim lppe As PROCESSENTRY32
Dim As DWORD hproc, hsnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0)
Dim As Long success
If hsnapshot Then
lppe.dwSize = SizeOf(lppe)
success = Process32First(hSnapshot, @lppe)
While success
If RTrim(lppe.szExeFile) = "javaw.exe" Then
hproc = OpenProcess(PROCESS_TERMINATE, 0, lppe.th32ProcessID)
TerminateProcess(hproc, 0)
CloseHandle(hproc)
Exit While
End If
success = Process32Next(hsnapshot, @lppe)
Wend
CloseHandle(hsnapshot)
End If
End
So, John ... what I'm looking for is something doing fast double buffered graphics and/or uses OpenGL -- you're 100% correct the combination Windows + Lisp + Graphics is a close to disaster situation ... (all seem focussing on Unix systems )
Hi John,
You could've started your new millennium with something better than advocating again in favor of a GNU GPL OS for microwave ovens and vacuum cleaners. See what your pimply "community efforts" are doing to the decent people's computers?! >:(
static __int64 binary_decode(const char* s) {
long x = 0; // <== !!! WRONG !!!
while (*s != 0 && (*s == '1' || *s == '0')) {
x <<= 1;
x += *s - '0';
s++;
}
return x;
}
and change long x = 0; to __int64 x = 0LL;.Sorry for having overlooked it before. Binary isn't my preferred notation.
Looking promising, Mike ;)It doesn't "looks", it "works"! 8)
(no vectors ?? - planning these in the future ? )Those GNU GPL gangs have been in for their Lisps for decades only to generate terrible heaps of bloatware that's non-responsive and crashy under Windows. I've been at nanoscheme for less than a week, and it does everything (and more) that it was supposed to do by its original author but didn't.
(attached / compiled as a distribution -- huge file ... this should work )Yes, this time it works but again, at the cost of a 15MB installation and two non-responsive windows -- a console and a tiny graphics "window leaf". I had to use my Task Manager to stop and kill the program again.
I wonder if it would be useful to create a Lisp-friendly GUI, as a DLL. All values could be exchanged in string (char*) form, so that communication would be as simple as print and input.
No more amateurish "community" mess -- been there, seen that.
History is made by leaders and individuals, not masses.
History has shown that dictators control the masses and are not leaders.
“Wen die Götter lieben, der stirbt jung” ... ,, (those loved by the Gods, die young -- or something like )
my excuses , but I had to tell -- i do not believe in Hitlers Stalins Churchills Kennedy's Kings & Popes
46.875 -- 50 mSec : a lot better than 22 Sec.
(of course Lisp as a native mechanism for above )
> (time (apply + L))
15.625
AFAIK Scheme can't even index lists
http://www.turtle.dds.nl/nothing/
In contrast, to Monarchical programming languages, require a strict class hierarchy, and creates subjects instead of objects. Subjects participate in ceremonies instead of procedures, and return tributes. When subjects no longer participate in ceremonies, they are exiled to the heap, but occasionally, they are executed.
+++++++++++++[->++>>>+++++>++>+<<<<<<]>>>>>++++++>--->>>>>>>>>>+++++++++++++++[[
>>>>>>>>>]+[<<<<<<<<<]>>>>>>>>>-]+[>>>>>>>>[-]>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>[-]+
<<<<<<<+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>>>+>>>>>>>>>>>>>>>>>>>>>>>>>>
>+<<<<<<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+[>>>>>>[>>>>>>>[-]>>]<<<<<<<<<[<<<<<<<<<]>>
>>>>>[-]+<<<<<<++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>>+<<<<<<+++++++[-[->>>
>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>>+<<<<<<<<<<<<<<<<[<<<<<<<<<]>>>[[-]>>>>>>[>>>>>
>>[-<<<<<<+>>>>>>]<<<<<<[->>>>>>+<<+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>
[>>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<+<<]>>>>>>>>]<<<<<<<<<[<<<<<<<
<<]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<<<]>>>>>>>>>+++++++++++++++[[
>>>>>>>>>]+>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[
>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>[-<<<<+>>>>]<<<<[->>>>+<<<<<[->>[
-<<+>>]<<[->>+>>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<
<<[>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<
[>[-]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+<<<<<<<<<]>>>>>
>>>>[>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+
<<<<<<[->>>[-<<<+>>>]<<<[->>>+>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>
>>>>>>>]<<<<<<<<<[>>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<<]>>[->>>>>>>>>+<<<<<<<<<]<<
+>>>>>>>>]<<<<<<<<<[>[-]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<
<]<+<<<<<<<<<]>>>>>>>>>[>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>>>>>>>>]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>>
>>>>>]<<<<<<<<<-<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+>>>>>>>>>>>>>>>>>>>>>+<<<[<<<<<<
<<<]>>>>>>>>>[>>>[-<<<->>>]+<<<[->>>->[-<<<<+>>>>]<<<<[->>>>+<<<<<<<<<<<<<[<<<<<
<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>[-<<<<->>>>]+<<<<[->>>>-<[-<<<+>>>]<<<[->
>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<
<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]<<<<<<<[->+>>>-<<<<]>>>>>>>>>+++++++++++++++++++
+++++++>>[-<<<<+>>>>]<<<<[->>>>+<<[-]<<]>>[<<<<<<<+<[-<+>>>>+<<[-]]>[-<<[->+>>>-
<<<<]>>>]>>>>>>>>>>>>>[>>[-]>[-]>[-]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-]>>>>>>[>>>>>
[-<<<<+>>>>]<<<<[->>>>+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>[-<<<<<<<<
<+>>>>>>>>>]>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>>>>>>>]+>[-
]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[>+>>>>>>>>]<<<
<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+<<<<<<[->>[-<<+>>]<
<[->>+>+<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[>[->>>>
>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[>[-]<->>>
[-<<<+>[<->-<<<<<<<+>>>>>>>]<[->+<]>>>]<<[->>+<<]<+<<<<<<<<<]>>>>>>>>>[>>>>>>[-<
<<<<+>>>>>]<<<<<[->>>>>+<<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>+>>>>>>>>
]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+<<<<<<[->>[-<<+
>>]<<[->>+>>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[>
[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[>[-
]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+<<<<<<<<<]>>>>>>>>>
[>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>++++++++
+++++++[[>>>>>>>>>]<<<<<<<<<-<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[>>>>>>>>[-<<<<<<<+
>>>>>>>]<<<<<<<[->>>>>>>+<<<<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>>[
-]>>>]<<<<<<<<<[<<<<<<<<<]>>>>+>[-<-<<<<+>>>>>]>[-<<<<<<[->>>>>+<++<<<<]>>>>>[-<
<<<<+>>>>>]<->+>]<[->+<]<<<<<[->>>>>+<<<<<]>>>>>>[-]<<<<<<+>>>>[-<<<<->>>>]+<<<<
[->>>>->>>>>[>>[-<<->>]+<<[->>->[-<<<+>>>]<<<[->>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-]
+>>>>>>[>>>>>>>>>]>+<]]+>>>[-<<<->>>]+<<<[->>>-<[-<<+>>]<<[->>+<<<<<<<<<<<[<<<<<
<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<<<<
[<<<<<<<<<]>>>>[-<<<<+>>>>]<<<<[->>>>+>>>>>[>+>>[-<<->>]<<[->>+<<]>>>>>>>>]<<<<<
<<<+<[>[->>>>>+<<<<[->>>>-<<<<<<<<<<<<<<+>>>>>>>>>>>[->>>+<<<]<]>[->>>-<<<<<<<<<
<<<<<+>>>>>>>>>>>]<<]>[->>>>+<<<[->>>-<<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>>+<<<]<<
<<<<<<<<<<]>>>>[-]<<<<]>>>[-<<<+>>>]<<<[->>>+>>>>>>[>+>[-<->]<[->+<]>>>>>>>>]<<<
<<<<<+<[>[->>>>>+<<<[->>>-<<<<<<<<<<<<<<+>>>>>>>>>>[->>>>+<<<<]>]<[->>>>-<<<<<<<
<<<<<<<+>>>>>>>>>>]<]>>[->>>+<<<<[->>>>-<<<<<<<<<<<<<<+>>>>>>>>>>]>]<[->>>>+<<<<
]<<<<<<<<<<<]>>>>>>+<<<<<<]]>>>>[-<<<<+>>>>]<<<<[->>>>+>>>>>[>>>>>>>>>]<<<<<<<<<
[>[->>>>>+<<<<[->>>>-<<<<<<<<<<<<<<+>>>>>>>>>>>[->>>+<<<]<]>[->>>-<<<<<<<<<<<<<<
+>>>>>>>>>>>]<<]>[->>>>+<<<[->>>-<<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>>+<<<]<<<<<<<
<<<<<]]>[-]>>[-]>[-]>>>>>[>>[-]>[-]>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>[-<
<<<+>>>>]<<<<[->>>>+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[
[>>>>>>>>>]+>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+
[>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>[-<<<<+>>>>]<<<<[->>>>+<<<<<[->>
[-<<+>>]<<[->>+>+<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<<
<[>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[
>[-]<->>>[-<<<+>[<->-<<<<<<<+>>>>>>>]<[->+<]>>>]<<[->>+<<]<+<<<<<<<<<]>>>>>>>>>[
>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]>
>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>[-]>>>>+++++++++++++++[[>>>>>>>>>]<<<<<<<<<-<<<<<
<<<<[<<<<<<<<<]>>>>>>>>>-]+[>>>[-<<<->>>]+<<<[->>>->[-<<<<+>>>>]<<<<[->>>>+<<<<<
<<<<<<<<[<<<<<<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>[-<<<<->>>>]+<<<<[->>>>-<[-
<<<+>>>]<<<[->>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>
>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-<<<+>>>]<<<[->>>+>>>>>>[>+>>>
[-<<<->>>]<<<[->>>+<<<]>>>>>>>>]<<<<<<<<+<[>[->+>[-<-<<<<<<<<<<+>>>>>>>>>>>>[-<<
+>>]<]>[-<<-<<<<<<<<<<+>>>>>>>>>>>>]<<<]>>[-<+>>[-<<-<<<<<<<<<<+>>>>>>>>>>>>]<]>
[-<<+>>]<<<<<<<<<<<<<]]>>>>[-<<<<+>>>>]<<<<[->>>>+>>>>>[>+>>[-<<->>]<<[->>+<<]>>
>>>>>>]<<<<<<<<+<[>[->+>>[-<<-<<<<<<<<<<+>>>>>>>>>>>[-<+>]>]<[-<-<<<<<<<<<<+>>>>
>>>>>>>]<<]>>>[-<<+>[-<-<<<<<<<<<<+>>>>>>>>>>>]>]<[-<+>]<<<<<<<<<<<<]>>>>>+<<<<<
]>>>>>>>>>[>>>[-]>[-]>[-]>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-]>[-]>>>>>[>>>>>>>[-<<<<<
<+>>>>>>]<<<<<<[->>>>>>+<<<<+<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>+>[-<-<<<<+>>>>
>]>>[-<<<<<<<[->>>>>+<++<<<<]>>>>>[-<<<<<+>>>>>]<->+>>]<<[->>+<<]<<<<<[->>>>>+<<
<<<]+>>>>[-<<<<->>>>]+<<<<[->>>>->>>>>[>>>[-<<<->>>]+<<<[->>>-<[-<<+>>]<<[->>+<<
<<<<<<<<<[<<<<<<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>[-<<->>]+<<[->>->[-<<<+>>>]<
<<[->>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<
<<<<<<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-<<<+>>>]<<<[->>>+>>>>>>[>+>[-<->]<[->+
<]>>>>>>>>]<<<<<<<<+<[>[->>>>+<<[->>-<<<<<<<<<<<<<+>>>>>>>>>>[->>>+<<<]>]<[->>>-
<<<<<<<<<<<<<+>>>>>>>>>>]<]>>[->>+<<<[->>>-<<<<<<<<<<<<<+>>>>>>>>>>]>]<[->>>+<<<
]<<<<<<<<<<<]>>>>>[-]>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<<<]]>>>>[-<<<<+>
>>>]<<<<[->>>>+>>>>>[>+>>[-<<->>]<<[->>+<<]>>>>>>>>]<<<<<<<<+<[>[->>>>+<<<[->>>-
<<<<<<<<<<<<<+>>>>>>>>>>>[->>+<<]<]>[->>-<<<<<<<<<<<<<+>>>>>>>>>>>]<<]>[->>>+<<[
->>-<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>+<<]<<<<<<<<<<<<]]>>>>[-]<<<<]>>>>[-<<<<+>>
>>]<<<<[->>>>+>[-]>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<<<]>>>>>>>>>[>>>>>>
>>>]<<<<<<<<<[>[->>>>+<<<[->>>-<<<<<<<<<<<<<+>>>>>>>>>>>[->>+<<]<]>[->>-<<<<<<<<
<<<<<+>>>>>>>>>>>]<<]>[->>>+<<[->>-<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>+<<]<<<<<<<<
<<<<]]>>>>>>>>>[>>[-]>[-]>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-]>[-]>>>>>[>>>>>[-<<<<+
>>>>]<<<<[->>>>+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>>[-<<<<<+>>>>>
]<<<<<[->>>>>+<<<+<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>>
>>>>>]+>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[>+>>
>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>[-<<<<+>>>>]<<<<[->>>>+<<<<<[->>[-<<+
>>]<<[->>+>>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[>
[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[>[-
]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+<<<<<<<<<]>>>>>>>>>
[>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+<<<<
<<[->>>[-<<<+>>>]<<<[->>>+>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>
>>>]<<<<<<<<<[>>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<<]>>[->>>>>>>>>+<<<<<<<<<]<<+>>>
>>>>>]<<<<<<<<<[>[-]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+
<<<<<<<<<]>>>>>>>>>[>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>>>>]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>>>>>>
>]<<<<<<<<<-<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+>>>>>>>>>>>>>>>>>>>>>+<<<[<<<<<<<<<]
>>>>>>>>>[>>>[-<<<->>>]+<<<[->>>->[-<<<<+>>>>]<<<<[->>>>+<<<<<<<<<<<<<[<<<<<<<<<
]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>[-<<<<->>>>]+<<<<[->>>>-<[-<<<+>>>]<<<[->>>+<
<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]>
>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>->>[-<<<<+>>>>]<<<<[->>>>+<<[-]<<]>>]<<+>>>>[-<<<<
->>>>]+<<<<[->>>>-<<<<<<.>>]>>>>[-<<<<<<<.>>>>>>>]<<<[-]>[-]>[-]>[-]>[-]>[-]>>>[
>[-]>[-]>[-]>[-]>[-]>[-]>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>[-]>>>>]<<<<<<<<<
[<<<<<<<<<]>+++++++++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>+>>>>>>>>>+<<<<<<<<
<<<<<<[<<<<<<<<<]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+[-]>>[>>>>>>>>>]<<<<<
<<<<[>>>>>>>[-<<<<<<+>>>>>>]<<<<<<[->>>>>>+<<<<<<<[<<<<<<<<<]>>>>>>>[-]+>>>]<<<<
<<<<<<]]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+>>[>+>>>>[-<<<<->>>>]<<<<[->>>
>+<<<<]>>>>>>>>]<<+<<<<<<<[>>>>>[->>+<<]<<<<<<<<<<<<<<]>>>>>>>>>[>>>>>>>>>]<<<<<
<<<<[>[-]<->>>>>>>[-<<<<<<<+>[<->-<<<+>>>]<[->+<]>>>>>>>]<<<<<<[->>>>>>+<<<<<<]<
+<<<<<<<<<]>>>>>>>-<<<<[-]+<<<]+>>>>>>>[-<<<<<<<->>>>>>>]+<<<<<<<[->>>>>>>->>[>>
>>>[->>+<<]>>>>]<<<<<<<<<[>[-]<->>>>>>>[-<<<<<<<+>[<->-<<<+>>>]<[->+<]>>>>>>>]<<
<<<<[->>>>>>+<<<<<<]<+<<<<<<<<<]>+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>+<<<
<<[<<<<<<<<<]>>>>>>>>>[>>>>>[-<<<<<->>>>>]+<<<<<[->>>>>->>[-<<<<<<<+>>>>>>>]<<<<
<<<[->>>>>>>+<<<<<<<<<<<<<<<<[<<<<<<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>>>>[-<
<<<<<<->>>>>>>]+<<<<<<<[->>>>>>>-<<[-<<<<<+>>>>>]<<<<<[->>>>>+<<<<<<<<<<<<<<[<<<
<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<<
<<[<<<<<<<<<]>>>>[-]<<<+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>-<<<<<[<<<<<<<
<<]]>>>]<<<<.>>>>>>>>>>[>>>>>>[-]>>>]<<<<<<<<<[<<<<<<<<<]>++++++++++[-[->>>>>>>>
>+<<<<<<<<<]>>>>>>>>>]>>>>>+>>>>>>>>>+<<<<<<<<<<<<<<<[<<<<<<<<<]>>>>>>>>[-<<<<<<
<<+>>>>>>>>]<<<<<<<<[->>>>>>>>+[-]>[>>>>>>>>>]<<<<<<<<<[>>>>>>>>[-<<<<<<<+>>>>>>
>]<<<<<<<[->>>>>>>+<<<<<<<<[<<<<<<<<<]>>>>>>>>[-]+>>]<<<<<<<<<<]]>>>>>>>>[-<<<<<
<<<+>>>>>>>>]<<<<<<<<[->>>>>>>>+>[>+>>>>>[-<<<<<->>>>>]<<<<<[->>>>>+<<<<<]>>>>>>
>>]<+<<<<<<<<[>>>>>>[->>+<<]<<<<<<<<<<<<<<<]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[>[-]<-
>>>>>>>>[-<<<<<<<<+>[<->-<<+>>]<[->+<]>>>>>>>>]<<<<<<<[->>>>>>>+<<<<<<<]<+<<<<<<
<<<]>>>>>>>>-<<<<<[-]+<<<]+>>>>>>>>[-<<<<<<<<->>>>>>>>]+<<<<<<<<[->>>>>>>>->[>>>
>>>[->>+<<]>>>]<<<<<<<<<[>[-]<->>>>>>>>[-<<<<<<<<+>[<->-<<+>>]<[->+<]>>>>>>>>]<<
<<<<<[->>>>>>>+<<<<<<<]<+<<<<<<<<<]>+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>
+>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>>[-<<<<<<->>>>>>]+<
<<<<<[->>>>>>->>[-<<<<<<<<+>>>>>>>>]<<<<<<<<[->>>>>>>>+<<<<<<<<<<<<<<<<<[<<<<<<<
<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>>>>>[-<<<<<<<<->>>>>>>>]+<<<<<<<<[->>>>>>>>
-<<[-<<<<<<+>>>>>>]<<<<<<[->>>>>>+<<<<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>
>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>[-]<<<++++
+[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>->>>>>>>>>>>>>>>>>>>>>>>>>>>-<<<<<<[<<<<
<<<<<]]>>>]
jrs@laptop:~/sb/sb22/bf$ time scriba tdef.sb
AAAAAAAAAAAAAAAABBBBBBBBBBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDEGFFEEEEDDDDDDCCCCCCCCCBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
AAAAAAAAAAAAAAABBBBBBBBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDEEEFGIIGFFEEEDDDDDDDDCCCCCCCCCBBBBBBBBBBBBBBBBBBBBBBBBBB
AAAAAAAAAAAAABBBBBBBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDEEEEFFFI KHGGGHGEDDDDDDDDDCCCCCCCCCBBBBBBBBBBBBBBBBBBBBBBB
AAAAAAAAAAAABBBBBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDEEEEEFFGHIMTKLZOGFEEDDDDDDDDDCCCCCCCCCBBBBBBBBBBBBBBBBBBBBB
AAAAAAAAAAABBBBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDEEEEEEFGGHHIKPPKIHGFFEEEDDDDDDDDDCCCCCCCCCCBBBBBBBBBBBBBBBBBB
AAAAAAAAAABBBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDDEEEEEEFFGHIJKS X KHHGFEEEEEDDDDDDDDDCCCCCCCCCCBBBBBBBBBBBBBBBB
AAAAAAAAABBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDDEEEEEEFFGQPUVOTY ZQL[MHFEEEEEEEDDDDDDDCCCCCCCCCCCBBBBBBBBBBBBBB
AAAAAAAABBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDDEEEEEFFFFFGGHJLZ UKHGFFEEEEEEEEDDDDDCCCCCCCCCCCCBBBBBBBBBBBB
AAAAAAABBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDEEEEFFFFFFGGGGHIKP KHHGGFFFFEEEEEEDDDDDCCCCCCCCCCCBBBBBBBBBBB
AAAAAAABBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDEEEEEFGGHIIHHHHHIIIJKMR VMKJIHHHGFFFFFFGSGEDDDDCCCCCCCCCCCCBBBBBBBBB
AAAAAABBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDEEEEEEFFGHK MKJIJO N R X YUSR PLV LHHHGGHIOJGFEDDDCCCCCCCCCCCCBBBBBBBB
AAAAABBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDEEEEEEEEEFFFFGH O TN S NKJKR LLQMNHEEDDDCCCCCCCCCCCCBBBBBBB
AAAAABBCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDEEEEEEEEEEEEFFFFFGHHIN Q UMWGEEEDDDCCCCCCCCCCCCBBBBBB
AAAABBCCCCCCCCCCCCCCCCCCCCCCCCCDDDDEEEEEEEEEEEEEEEFFFFFFGHIJKLOT [JGFFEEEDDCCCCCCCCCCCCCBBBBB
AAAABCCCCCCCCCCCCCCCCCCCCCCDDDDEEEEEEEEEEEEEEEEFFFFFFGGHYV RQU QMJHGGFEEEDDDCCCCCCCCCCCCCBBBB
AAABCCCCCCCCCCCCCCCCCDDDDDDDEEFJIHFFFFFFFFFFFFFFGGGGGGHIJN JHHGFEEDDDDCCCCCCCCCCCCCBBB
AAABCCCCCCCCCCCDDDDDDDDDDEEEEFFHLKHHGGGGHHMJHGGGGGGHHHIKRR UQ L HFEDDDDCCCCCCCCCCCCCCBB
AABCCCCCCCCDDDDDDDDDDDEEEEEEFFFHKQMRKNJIJLVS JJKIIIIIIJLR YNHFEDDDDDCCCCCCCCCCCCCBB
AABCCCCCDDDDDDDDDDDDEEEEEEEFFGGHIJKOU O O PR LLJJJKL OIHFFEDDDDDCCCCCCCCCCCCCCB
AACCCDDDDDDDDDDDDDEEEEEEEEEFGGGHIJMR RMLMN NTFEEDDDDDDCCCCCCCCCCCCCB
AACCDDDDDDDDDDDDEEEEEEEEEFGGGHHKONSZ QPR NJGFEEDDDDDDCCCCCCCCCCCCCC
ABCDDDDDDDDDDDEEEEEFFFFFGIPJIIJKMQ VX HFFEEDDDDDDCCCCCCCCCCCCCC
ACDDDDDDDDDDEFFFFFFFGGGGHIKZOOPPS HGFEEEDDDDDDCCCCCCCCCCCCCC
ADEEEEFFFGHIGGGGGGHHHHIJJLNY TJHGFFEEEDDDDDDDCCCCCCCCCCCCC
A PLJHGGFFEEEDDDDDDDCCCCCCCCCCCCC
ADEEEEFFFGHIGGGGGGHHHHIJJLNY TJHGFFEEEDDDDDDDCCCCCCCCCCCCC
ACDDDDDDDDDDEFFFFFFFGGGGHIKZOOPPS HGFEEEDDDDDDCCCCCCCCCCCCCC
ABCDDDDDDDDDDDEEEEEFFFFFGIPJIIJKMQ VX HFFEEDDDDDDCCCCCCCCCCCCCC
AACCDDDDDDDDDDDDEEEEEEEEEFGGGHHKONSZ QPR NJGFEEDDDDDDCCCCCCCCCCCCCC
AACCCDDDDDDDDDDDDDEEEEEEEEEFGGGHIJMR RMLMN NTFEEDDDDDDCCCCCCCCCCCCCB
AABCCCCCDDDDDDDDDDDDEEEEEEEFFGGHIJKOU O O PR LLJJJKL OIHFFEDDDDDCCCCCCCCCCCCCCB
AABCCCCCCCCDDDDDDDDDDDEEEEEEFFFHKQMRKNJIJLVS JJKIIIIIIJLR YNHFEDDDDDCCCCCCCCCCCCCBB
AAABCCCCCCCCCCCDDDDDDDDDDEEEEFFHLKHHGGGGHHMJHGGGGGGHHHIKRR UQ L HFEDDDDCCCCCCCCCCCCCCBB
AAABCCCCCCCCCCCCCCCCCDDDDDDDEEFJIHFFFFFFFFFFFFFFGGGGGGHIJN JHHGFEEDDDDCCCCCCCCCCCCCBBB
AAAABCCCCCCCCCCCCCCCCCCCCCCDDDDEEEEEEEEEEEEEEEEFFFFFFGGHYV RQU QMJHGGFEEEDDDCCCCCCCCCCCCCBBBB
AAAABBCCCCCCCCCCCCCCCCCCCCCCCCCDDDDEEEEEEEEEEEEEEEFFFFFFGHIJKLOT [JGFFEEEDDCCCCCCCCCCCCCBBBBB
AAAAABBCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDEEEEEEEEEEEEFFFFFGHHIN Q UMWGEEEDDDCCCCCCCCCCCCBBBBBB
AAAAABBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDEEEEEEEEEFFFFGH O TN S NKJKR LLQMNHEEDDDCCCCCCCCCCCCBBBBBBB
AAAAAABBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDEEEEEEFFGHK MKJIJO N R X YUSR PLV LHHHGGHIOJGFEDDDCCCCCCCCCCCCBBBBBBBB
AAAAAAABBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDEEEEEFGGHIIHHHHHIIIJKMR VMKJIHHHGFFFFFFGSGEDDDDCCCCCCCCCCCCBBBBBBBBB
AAAAAAABBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDEEEEFFFFFFGGGGHIKP KHHGGFFFFEEEEEEDDDDDCCCCCCCCCCCBBBBBBBBBBB
AAAAAAAABBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDDEEEEEFFFFFGGHJLZ UKHGFFEEEEEEEEDDDDDCCCCCCCCCCCCBBBBBBBBBBBB
AAAAAAAAABBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDDEEEEEEFFGQPUVOTY ZQL[MHFEEEEEEEDDDDDDDCCCCCCCCCCCBBBBBBBBBBBBBB
AAAAAAAAAABBBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDDEEEEEEFFGHIJKS X KHHGFEEEEEDDDDDDDDDCCCCCCCCCCBBBBBBBBBBBBBBBB
AAAAAAAAAAABBBBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDEEEEEEFGGHHIKPPKIHGFFEEEDDDDDDDDDCCCCCCCCCCBBBBBBBBBBBBBBBBBB
AAAAAAAAAAAABBBBBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDDDEEEEEFFGHIMTKLZOGFEEDDDDDDDDDCCCCCCCCCBBBBBBBBBBBBBBBBBBBBB
AAAAAAAAAAAAABBBBBBBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDDDEEEEFFFI KHGGGHGEDDDDDDDDDCCCCCCCCCBBBBBBBBBBBBBBBBBBBBBBB
AAAAAAAAAAAAAAABBBBBBBBBBBBBCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCDDDDDDDDDDEEEFGIIGFFEEEDDDDDDDDCCCCCCCCCBBBBBBBBBBBBBBBBBBBBBBBBBB
real 8m34.051s
user 8m33.587s
sys 0m0.036s
jrs@laptop:~/sb/sb22/bf$
That was the first one of your obvious shoot-and-misses way back then, John.
So I shamelessly copied his code...yet I will not waste more time with it
But would it be possible to create a working executable for Win 64bit?
I will try OxyScheme to learn a bit more about Scheme.
Any call to __p__iob() causes instant GPF. Is there a substitute for obtaining an _iob FILE pointer ?
I'm tracking through the startup sequence, and I'll watch out for the longjmp.
As I recall, this complexity arose from coercing MSVCRT route its console outputs through the STDOUT pipeline, so that console output could be redirected when using printf or fprintf
We can let this topic rest, if you prefer. Your dynamic glsl shading idea must take priority :)
In Oxygen terms, this would take the form of a customised compiler, supporting both static and dynamic compiling. Similarly in FBSL, such a scheme would be firmly linked to FBSL's frameworks and future development path.
Let me throw in an o2 assembler example
only the author knows what that means. ( ), repeat, fwd, exit, and so on!
a small tutorial would be good. everything in small steps might tell us the mystery.
The secrets of o2 asm;D
Guys,
Y'all will spare yourselves a little PITA if you notice that prime numbers can't be even. ;)
No noticeable improvement using a STEP 2 to skip even numbers.
Would you have time to whip up an efficient TinyScheme prime number example that emulate the SB & Perl examples?
(This code should also run in OxyScheme!)
(This code should also run in OxyScheme!)
It runs but it doesn't produce the expected results. There must be still some bugs somewhere in OxyScheme... :(
Perhaps this can stimulate your imagination towards some scenarios that haven't yet been considered.
It's difficult for me to talk in terms of SQLite or Linux system libraries, but under Windows, it could mean, for example, writing an .scm library that would interface with user32.dll, gdi32.dll and opengl32.dll APIs, define a set of high-level macros and procedures on top of them, and using this library as an OpenGL-capable windowed GUI with standard forms, controls, dialogs and what not instead of that crooked Java trash Rob was polluting our gear with.