mirror of
https://github.com/kanaka/mal.git
synced 2024-09-19 09:38:28 +03:00
Merge pull request #390 from bjh21/bjh21-bbc-basic
bbc-basic: Assorted fixes
This commit is contained in:
Joel Martin
GitHub
commit
ad4f7b1f62
@ -1,6 +1,6 @@
|
||||
# Introduction
|
||||
|
||||
This is a (partial) implementation of mal in BBC BASIC V. While there
|
||||
This is an implementation of mal in BBC BASIC V. While there
|
||||
is already an implementation of mal in BASIC (in the "basic"
|
||||
directory), it's targeted at much more primitive versions of BASIC and
|
||||
relies on a pre-processor, both of which make it fairly un-idiomatic
|
||||
|
||||
@ -400,24 +400,26 @@ DEF FNcore_slurp(file$)
|
||||
LOCAL f%, out%
|
||||
f% = OPENIN(file$)
|
||||
IF f% = 0 THEN ERROR &40E80940, "File '"+file$+"' not found"
|
||||
out% = FNalloc_string("")
|
||||
WHILE NOT EOF#f%
|
||||
REM GET$# doesn't include a trailing newline.
|
||||
PROCstring_append(out%, GET$#f% + CHR$(10))
|
||||
ENDWHILE
|
||||
out% = FNcore_slurp_channel(f%)
|
||||
CLOSE#f%
|
||||
=out%
|
||||
|
||||
DEF FNcore_slurp_channel(f%)
|
||||
LOCAL this%
|
||||
IF EOF#f% THEN =FNalloc_string("")
|
||||
REM GET$# doesn't include a trailing newline.
|
||||
this% = FNalloc_string(GET$#f% + CHR$(10))
|
||||
=FNstring_concat(this%, FNcore_slurp_channel(f%))
|
||||
|
||||
REM General-purpose printing function
|
||||
DEF FNcore_print(print_readably%, sep$, args%)
|
||||
LOCAL out%
|
||||
IF FNis_empty(args%) THEN =FNalloc_string("")
|
||||
out% = FNalloc_string("")
|
||||
PROCstring_concat(out%, FNpr_str(FNfirst(args%), print_readably%))
|
||||
out% = FNpr_str(FNfirst(args%), print_readably%)
|
||||
args% = FNrest(args%)
|
||||
WHILE NOT FNis_empty(args%)
|
||||
PROCstring_append(out%, sep$)
|
||||
PROCstring_concat(out%, FNpr_str(FNfirst(args%), print_readably%))
|
||||
out% = FNstring_append(out%, sep$)
|
||||
out% = FNstring_concat(out%, FNpr_str(FNfirst(args%), print_readably%))
|
||||
args% = FNrest(args%)
|
||||
ENDWHILE
|
||||
=out%
|
||||
|
||||
@ -15,36 +15,36 @@ DEF FNpr_str(val%, print_readably%)
|
||||
IF FNis_symbol(val%) THEN =FNalloc_string(FNunbox_symbol(val%))
|
||||
IF FNis_corefn(val%) OR FNis_fn(val%) THEN =FNalloc_string("#<function>")
|
||||
IF FNis_seq(val%) THEN
|
||||
ret% = FNalloc_string("(") : term$ = ")"
|
||||
IF FNis_vector(val%) THEN ret% = FNalloc_string("[") : term$ = "]"
|
||||
IF FNis_vector(val%) THEN
|
||||
ret% = FNalloc_string("[") : term$ = "]"
|
||||
ELSE
|
||||
ret% = FNalloc_string("(") : term$ = ")"
|
||||
ENDIF
|
||||
WHILE NOT FNis_empty(val%)
|
||||
IF FNstring_len(ret%) > 1 THEN PROCstring_append(ret%, " ")
|
||||
PROCstring_concat(ret%, FNpr_str(FNfirst(val%), print_readably%))
|
||||
IF FNstring_len(ret%) > 1 THEN ret% = FNstring_append(ret%, " ")
|
||||
ret% = FNstring_concat(ret%, FNpr_str(FNfirst(val%), print_readably%))
|
||||
val% = FNrest(val%)
|
||||
ENDWHILE
|
||||
PROCstring_append(ret%, term$)
|
||||
=ret%
|
||||
=FNstring_append(ret%, term$)
|
||||
ENDIF
|
||||
IF FNis_hashmap(val%) THEN
|
||||
ret% = FNalloc_string("{")
|
||||
keys% = FNhashmap_keys(val%)
|
||||
vals% = FNhashmap_vals(val%)
|
||||
WHILE NOT FNis_empty(keys%)
|
||||
IF FNstring_len(ret%) > 1 THEN PROCstring_append(ret%, " ")
|
||||
PROCstring_concat(ret%, FNpr_str(FNfirst(keys%), print_readably%))
|
||||
PROCstring_append(ret%, " ")
|
||||
PROCstring_concat(ret%, FNpr_str(FNfirst(vals%), print_readably%))
|
||||
IF FNstring_len(ret%) > 1 THEN ret% = FNstring_append(ret%, " ")
|
||||
ret% = FNstring_concat(ret%, FNpr_str(FNfirst(keys%), print_readably%))
|
||||
ret% = FNstring_append(ret%, " ")
|
||||
ret% = FNstring_concat(ret%, FNpr_str(FNfirst(vals%), print_readably%))
|
||||
keys% = FNrest(keys%)
|
||||
vals% = FNrest(vals%)
|
||||
ENDWHILE
|
||||
PROCstring_append(ret%, "}")
|
||||
=ret%
|
||||
=FNstring_append(ret%, "}")
|
||||
ENDIF
|
||||
IF FNis_atom(val%) THEN
|
||||
ret% = FNalloc_string("(atom ")
|
||||
PROCstring_concat(ret%, FNpr_str(FNatom_deref(val%), print_readably%))
|
||||
PROCstring_append(ret%, ")")
|
||||
=ret%
|
||||
ret% = FNstring_concat(ret%, FNpr_str(FNatom_deref(val%), print_readably%))
|
||||
=FNstring_append(ret%, ")")
|
||||
ENDIF
|
||||
ERROR &40E809F0, "Unprintable value"
|
||||
|
||||
|
||||
160
bbc-basic/types
160
bbc-basic/types
@ -7,23 +7,14 @@ REM code should use routines in this library to access them.
|
||||
REM As far as other code is concerned, a mal object is just an
|
||||
REM opaque 32-bit integer, which might be a pointer, or might not.
|
||||
|
||||
REM Following the 8-bit BASIC implementation, we currently have two
|
||||
REM arrays, Z%() containing most objects and S$() containing strings
|
||||
REM (referenced from Z%()). Unlike that implementation, we use a
|
||||
REM two-dimensional array where each object is a whole row. This
|
||||
REM is inefficient but should make memory management simpler.
|
||||
|
||||
REM S%() holds an integer for each string in S$(). These are used
|
||||
REM to link strings together so that a mal string can be longer than
|
||||
REM is allowed by the 255 characters allowed by the Acorn interpreter.
|
||||
REM These integers are also used to chain unused entries in S$() into
|
||||
REM a free list.
|
||||
REM All mal objects live in an array, Z%(), with string values held
|
||||
REM in a parallel array, Z$(). There's one row in Z%(), and one
|
||||
REM entry in Z$(), for each mal object.
|
||||
|
||||
REM Z%(x,0) holds the type of an object and other small amounts of
|
||||
REM information. The bottom 2 bits indicate the semantics of Z%(x,1):
|
||||
REM information. The bottom bit indicates the semantics of Z%(x,1):
|
||||
|
||||
REM &01 : Z%(x,1) is a pointer into Z%()
|
||||
REM &02 : Z%(x,1) is a pointer into S$()
|
||||
|
||||
REM Z%(x,2) and Z%(x,3) are always pointers into Z%(), to 'nil' if nothing
|
||||
REM else.
|
||||
@ -57,22 +48,27 @@ REM &0A hash-map leaf node
|
||||
REM Formats of individual objects are defined below.
|
||||
|
||||
DEF PROCtypes_init
|
||||
REM Arbitrarily use a quarter of BASIC's heap as the mal heap, with a bit
|
||||
REM more for strings. Each heap entry is sixteen bytes.
|
||||
DIM Z%((HIMEM-LOMEM)/64,3)
|
||||
DIM S$((HIMEM-LOMEM)/128), S%((HIMEM-LOMEM)/128)
|
||||
REM Mal's heap has to be statically dimensioned, but we also
|
||||
REM need to leave enough space for BASIC's stack and heap.
|
||||
REM The BASIC heap is where all strings live.
|
||||
REM
|
||||
REM Each row of Z%() consumes 16 bytes. The size of each entry
|
||||
REM in Z$() varies by platform: 5 bytes in ARM BBC BASIC V,
|
||||
REM 8 bytes in Brandy on a 32-bit system, 16 bytes in Brandy on
|
||||
REM a 64-bit system.
|
||||
|
||||
DIM Z%((HIMEM-LOMEM)/100,3), Z$((HIMEM-LOMEM)/100)
|
||||
DIM sS%((HIMEM-LOMEM)/64)
|
||||
|
||||
Z%(1,0) = &04 : REM false
|
||||
Z%(2,0) = &04 : Z%(2,1) = TRUE : REM true
|
||||
Z%(3,0) = &49 : Z%(3,1) = 3 : REM empty list
|
||||
Z%(4,0) = &C9 : Z%(4,1) = 4 : REM empty vector
|
||||
Z%(5,0) = &51 : REM empty hashmap
|
||||
next_Z% = 6
|
||||
next_S% = 1
|
||||
sSP% = 1
|
||||
sFP% = 0
|
||||
F% = 0
|
||||
SF% = 0
|
||||
ENDPROC
|
||||
|
||||
DEF FNtype_of(val%)
|
||||
@ -142,39 +138,15 @@ DEF FNmalloc(type%)
|
||||
Z%(val%,0) = type%
|
||||
=FNref_local(val%)
|
||||
|
||||
DEF FNsalloc(s$)
|
||||
LOCAL val%
|
||||
IF SF% <> 0 THEN
|
||||
val% = SF%
|
||||
SF% = S%(val%)
|
||||
S%(val%) = 0
|
||||
ELSE
|
||||
val% = next_S%
|
||||
next_S% += 1
|
||||
ENDIF
|
||||
S$(val%) = s$
|
||||
=val%
|
||||
|
||||
DEF PROCfree(val%)
|
||||
IF (Z%(val%,0) AND &02) THEN PROCsfree(Z%(val%,1))
|
||||
Z%(val%,0) = &05
|
||||
Z%(val%,1) = F%
|
||||
Z%(val%,2) = 0
|
||||
Z%(val%,3) = 0
|
||||
Z$(val%) = ""
|
||||
F% = val%
|
||||
ENDPROC
|
||||
|
||||
DEF PROCsfree(val%)
|
||||
LOCAL next%
|
||||
WHILE val% <> 0
|
||||
S$(val%) = ""
|
||||
next% = S%(val%)
|
||||
S%(val%) = SF%
|
||||
SF% = val%
|
||||
val% = next%
|
||||
ENDWHILE
|
||||
ENDPROC
|
||||
|
||||
DEF PROCgc
|
||||
REM PRINT "** START GC **"
|
||||
PROCgc_markall
|
||||
@ -225,11 +197,11 @@ DEF FNmeta(val%)
|
||||
|
||||
DEF FNwith_meta(val%, meta%)
|
||||
LOCAL newval%
|
||||
IF Z%(val%,0) AND &02 ERROR &40E8091F, "Can't apply metadata to a string-like type"
|
||||
newval% = FNmalloc(Z%(val%,0))
|
||||
Z%(newval%,1) = Z%(val%,1)
|
||||
Z%(newval%,2) = Z%(val%,2)
|
||||
Z%(newval%,3) = meta%
|
||||
Z$(newval%) = Z$(val%)
|
||||
=newval%
|
||||
|
||||
REM ** Nil **
|
||||
@ -279,6 +251,8 @@ DEF FNunbox_int(val%)
|
||||
|
||||
REM ** Strings and keywords **
|
||||
|
||||
REM Z$(x) is the string value
|
||||
REM Z%(x,2) points to the next part of the string
|
||||
REM A keyword is a string with first character CHR$(127).
|
||||
|
||||
DEF FNis_string(val%)
|
||||
@ -287,63 +261,65 @@ DEF FNis_string(val%)
|
||||
DEF FNalloc_string(sval$)
|
||||
LOCAL val%
|
||||
val% = FNmalloc(&02)
|
||||
Z%(val%,1) = FNsalloc(sval$)
|
||||
Z$(val%) = sval$
|
||||
=val%
|
||||
|
||||
DEF FNunbox_string(val%)
|
||||
IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string"
|
||||
IF S%(Z%(val%,1)) ERROR &40E80914, "Cannot unbox a long string"
|
||||
=S$(Z%(val%,1))
|
||||
IF NOT FNis_nil(Z%(val%,2)) ERROR &40E80914, "Cannot unbox a long string"
|
||||
=Z$(val%)
|
||||
|
||||
REM Note that this mutates an existing value. Use with care!
|
||||
DEF PROCstring_append(val%, add$)
|
||||
LOCAL s%
|
||||
DEF FNstring_append(val%, add$)
|
||||
LOCAL newval%
|
||||
IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string"
|
||||
s% = (Z%(val%,1))
|
||||
WHILE S%(s%) <> 0
|
||||
s% = S%(s%)
|
||||
ENDWHILE
|
||||
IF LEN(S$(s%)) + LEN(add$) <= 255 THEN
|
||||
S$(s%) += add$
|
||||
newval% = FNalloc_string(Z$(val%))
|
||||
IF FNis_nil(Z%(val%,2)) THEN
|
||||
IF LEN(Z$(newval%)) + LEN(add$) <= 255 THEN
|
||||
Z$(newval%) += add$
|
||||
ELSE
|
||||
Z%(newval%,2) = FNalloc_string(add$)
|
||||
ENDIF
|
||||
ELSE
|
||||
S%(s%) = FNsalloc(add$)
|
||||
Z%(newval%,2) = FNstring_append(Z%(val%,2), add$)
|
||||
ENDIF
|
||||
ENDPROC
|
||||
=newval%
|
||||
|
||||
REM So does this.
|
||||
DEF PROCstring_concat(val%, add%)
|
||||
LOCAL s%
|
||||
DEF FNstring_concat(val%, add%)
|
||||
LOCAL newval%
|
||||
IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string"
|
||||
IF NOT FNis_string(add%) THEN ERROR &40E80914, "Not a string"
|
||||
s% = (Z%(add%,1))
|
||||
WHILE s% <> 0
|
||||
PROCstring_append(val%, S$(s%))
|
||||
s% = S%(s%)
|
||||
ENDWHILE
|
||||
ENDPROC
|
||||
newval% = FNalloc_string(Z$(val%))
|
||||
IF FNis_nil(Z%(val%,2)) THEN
|
||||
IF LEN(Z$(newval%)) + LEN(Z$(add%)) <= 255 THEN
|
||||
Z$(newval%) += Z$(add%)
|
||||
Z%(newval%,2) = Z%(add%,2)
|
||||
ELSE
|
||||
Z%(newval%,2) = add%
|
||||
ENDIF
|
||||
ELSE
|
||||
Z%(newval%,2) = FNstring_concat(Z%(val%,2), add%)
|
||||
ENDIF
|
||||
=newval%
|
||||
|
||||
DEF FNstring_len(val%)
|
||||
LOCAL s%, len%
|
||||
s% = Z%(val%,1)
|
||||
WHILE s% <> 0
|
||||
len% += LEN(S$(s%))
|
||||
s% = S%(s%)
|
||||
LOCAL len%
|
||||
WHILE NOT FNis_nil(val%)
|
||||
len% += LEN(Z$(val%))
|
||||
val% = Z%(val%,2)
|
||||
ENDWHILE
|
||||
=len%
|
||||
|
||||
DEF FNstring_chr(val%, pos%)
|
||||
LOCAL s%
|
||||
s% = Z%(val%,1)
|
||||
WHILE pos% > LEN(S$(s%))
|
||||
pos% -= LEN(S$(s%))
|
||||
s% = S%(s%)
|
||||
IF s% = 0 THEN =""
|
||||
WHILE pos% > LEN(Z$(val%))
|
||||
pos% -= LEN(Z$(val%))
|
||||
val% = Z%(val%,2)
|
||||
IF FNis_nil(val%) THEN =""
|
||||
ENDWHILE
|
||||
=MID$(S$(s%), pos%, 1)
|
||||
=MID$(Z$(val%), pos%, 1)
|
||||
|
||||
REM ** Symbols **
|
||||
|
||||
REM Z%(x,1) = index in S$() of the value of the symbol
|
||||
REM Z$(x) = value of the symbol
|
||||
|
||||
DEF FNis_symbol(val%)
|
||||
=FNtype_of(val%) = &06
|
||||
@ -351,12 +327,12 @@ DEF FNis_symbol(val%)
|
||||
DEF FNalloc_symbol(sval$)
|
||||
LOCAL val%
|
||||
val% = FNmalloc(&06)
|
||||
Z%(val%,1) = FNsalloc(sval$)
|
||||
Z$(val%) = sval$
|
||||
=val%
|
||||
|
||||
DEF FNunbox_symbol(val%)
|
||||
IF NOT FNis_symbol(val%) THEN ERROR &40E80915, "Not a symbol"
|
||||
=S$(Z%(val%,1))
|
||||
=Z$(val%)
|
||||
|
||||
REM ** Lists and vectors **
|
||||
|
||||
@ -472,7 +448,7 @@ REM Z%(x,1) = index in Z%() of left child (if next bit of key is 0)
|
||||
REM Z%(x,2) = index in Z%() of right child (if next bit of key is 1)
|
||||
|
||||
REM A leaf node has
|
||||
REM Z%(x,1) = index in S$() of key
|
||||
REM Z$(x) = key
|
||||
REM Z%(x,2) = index in Z%() of value
|
||||
|
||||
REM The empty hash-map is a special value containing no data.
|
||||
@ -483,7 +459,7 @@ DEF FNempty_hashmap
|
||||
DEF FNhashmap_alloc_leaf(key$, val%)
|
||||
LOCAL entry%
|
||||
entry% = FNmalloc(&0A)
|
||||
Z%(entry%,1) = FNsalloc(key$)
|
||||
Z$(entry%) = key$
|
||||
Z%(entry%,2) = val%
|
||||
=entry%
|
||||
|
||||
@ -517,8 +493,8 @@ DEF FNhashmap_set(map%, key$, val%)
|
||||
LOCAL bit%, nearest%
|
||||
IF FNis_empty(map%) THEN =FNhashmap_alloc_leaf(key$, val%)
|
||||
nearest% = FNhashmap_find(map%, key$)
|
||||
IF S$(Z%(nearest%,1)) = key$ THEN =FNhashmap_replace(map%, key$, val%)
|
||||
bit% = FNkey_bitdiff(key$, S$(Z%(nearest%,1)))
|
||||
IF Z$(nearest%) = key$ THEN =FNhashmap_replace(map%, key$, val%)
|
||||
bit% = FNkey_bitdiff(key$, Z$(nearest%))
|
||||
=FNhashmap_insert(map%, bit%, key$, val%)
|
||||
|
||||
DEF FNhashmap_insert(map%, bit%, key$, val%)
|
||||
@ -560,7 +536,7 @@ DEF FNhashmap_remove(map%, key$)
|
||||
LOCAL child%
|
||||
IF FNis_empty(map%) THEN =map%
|
||||
IF FNtype_of(map%) = &0A THEN
|
||||
IF S$(Z%(map%,1)) = key$ THEN =FNempty_hashmap
|
||||
IF Z$(map%) = key$ THEN =FNempty_hashmap
|
||||
ENDIF
|
||||
IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN
|
||||
child% = FNhashmap_remove(Z%(map%,2), key$)
|
||||
@ -584,13 +560,13 @@ DEF FNhashmap_get(map%, key$)
|
||||
IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap"
|
||||
IF FNis_empty(map%) THEN =FNnil
|
||||
map% = FNhashmap_find(map%, key$)
|
||||
IF S$(Z%(map%,1)) = key$ THEN =FNref_local(Z%(map%,2)) ELSE =FNnil
|
||||
IF Z$(map%) = key$ THEN =FNref_local(Z%(map%,2)) ELSE =FNnil
|
||||
|
||||
DEF FNhashmap_contains(map%, key$)
|
||||
IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap"
|
||||
IF FNis_empty(map%) THEN =FALSE
|
||||
map% = FNhashmap_find(map%, key$)
|
||||
=S$(Z%(map%,1)) = key$
|
||||
=Z$(map%) = key$
|
||||
|
||||
DEF FNhashmap_keys(map%)
|
||||
=FNhashmap_keys1(map%, FNempty)
|
||||
@ -598,7 +574,7 @@ DEF FNhashmap_keys(map%)
|
||||
DEF FNhashmap_keys1(map%, acc%)
|
||||
IF FNis_empty(map%) THEN =acc%
|
||||
IF FNtype_of(map%) = &0A THEN
|
||||
=FNalloc_pair(FNalloc_string(S$(Z%(map%,1))), acc%)
|
||||
=FNalloc_pair(FNalloc_string(Z$(map%)), acc%)
|
||||
ENDIF
|
||||
=FNhashmap_keys1(Z%(map%,1), FNhashmap_keys1(Z%(map%,2), acc%))
|
||||
|
||||
@ -622,7 +598,7 @@ DEF PROChashmap_dump(map%)
|
||||
ENDPROC
|
||||
|
||||
DEF PROChashmap_dump_internal(map%, prefix$)
|
||||
IF FNtype_of(map%) = &0A PRINT prefix$;S$(Z%(map%,1))
|
||||
IF FNtype_of(map%) = &0A PRINT prefix$;Z$(map%)
|
||||
IF FNtype_of(map%) = &11 THEN
|
||||
PRINT prefix$;"<";Z%(map%,0) >> 16;">"
|
||||
PROChashmap_dump_internal(Z%(map%,1), prefix$ + "L ")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user