[jackhill/mal.git] / basic / mem.in.bas

REM Memory layout:
REM
REM type            bytes
REM ----------      ----------
REM nil             ref/ 0 |  0          |              |
REM false           ref/ 1 |  0          |              |
REM true            ref/ 1 |  1          |              |
REM integer         ref/ 2 | int         |              |
REM float           ref/ 3 | ???         |              |
REM string/kw       ref/ 4 | S$ idx      |              |
REM symbol          ref/ 5 | S$ idx      |              |
REM list            ref/ 6 | next Z% idx | val Z% idx   |
REM vector          ref/ 7 | next Z% idx | val Z% idx   |
REM hashmap         ref/ 8 | next Z% idx | key Z% idx   | val Z% idx
REM function        ref/ 9 | fn idx      |              |
REM mal function    ref/10 | body Z% idx | param Z% idx | env Z% idx
REM macro fn        ref/11 | body Z% idx | param Z% idx | env Z% idx
REM atom            ref/12 | val Z% idx  |              |
REM environment     ref/13 | hmap Z% idx | outer Z% idx |
REM metadata        ref/14 | obj Z% idx  | meta Z% idx  |
REM FREE             sz/15 | next Z% idx |              |
REM
REM Locations 0-15 are for constant/persistent values:
REM    0: nil
REM    2: false
REM    4: true
REM    6: empty list
REM    9: empty vector
REM   12: empty hash-map

REM Note: DIM_MEMORY for C64 BASIC and the INIT_MEMORY function are at
REM end of this file for efficiency on C64. The most commonly used
REM function should be at the top since C64 BASIC scans line numbers
REM for every GOTO/GOSUB. On the other hand, QBasic requires that
REM arrays are dimensioned at the top of the file, not just as the
REM first operation on that array so DIM_MEMORY for QBasic is here at
REM the top.

#qbasic DIM_MEMORY:
#qbasic   T=0
#qbasic
#qbasic   Z1=8191+1424: REM Z% (boxed memory) size (2 bytes each)
#qbasic   Z2=199: REM S$/S% (string memory) size (3+2 bytes each)
#qbasic   Z3=200: REM X% (call stack) size (2 bytes each)
#qbasic   Z4=64: REM Y% (release stack) size (4 bytes each)
#qbasic
#qbasic   REM boxed element memory
#qbasic   DIM Z%(Z1): REM TYPE ARRAY
#qbasic
#qbasic   REM string memory storage
#qbasic   S=0:DIM S$(Z2):DIM S%(Z2)
#qbasic
#qbasic   REM call/logic stack
#qbasic   X=-1:DIM X%(Z3): REM stack of Z% indexes
#qbasic
#qbasic   REM pending release stack
#qbasic   Y=-1:DIM Y%(Z4,1): REM stack of Z% indexes and level/LV values
#qbasic
#qbasic   RETURN

REM stack functions

#qbasic PUSH_A:
#qbasic   X=X+1:X%(X)=A:RETURN
#qbasic POP_A:
#qbasic   A=X%(X):X=X-1:RETURN
#qbasic
#qbasic PUSH_R:
#qbasic   X=X+1:X%(X)=R:RETURN
#qbasic POP_R:
#qbasic   R=X%(X):X=X-1:RETURN
#qbasic
#qbasic PUSH_Q:
#qbasic   X=X+1:X%(X)=Q:RETURN
#qbasic POP_Q:
#qbasic   Q=X%(X):X=X-1:RETURN
#qbasic PEEK_Q:
#qbasic   Q=X%(X):RETURN
#qbasic PEEK_Q_1:
#qbasic   Q=X%(X-1):RETURN
#qbasic PEEK_Q_2:
#qbasic   Q=X%(X-2):RETURN
#qbasic PEEK_Q_Q:
#qbasic   Q=X%(X-Q):RETURN
#qbasic PUT_Q:
#qbasic   X%(X)=Q:RETURN
#qbasic PUT_Q_1:
#qbasic   X%(X-1)=Q:RETURN
#qbasic PUT_Q_2:
#qbasic   X%(X-2)=Q:RETURN

#cbm PUSH_A:
#cbm   X=X+2:POKE X,A AND255:POKE X+1,A/256:RETURN
#cbm POP_A:
#cbm   A=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN
#cbm
#cbm PUSH_R:
#cbm   X=X+2:POKE X,R AND255:POKE X+1,R/256:RETURN
#cbm POP_R:
#cbm   R=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN
#cbm
#cbm PUSH_Q:
#cbm   X=X+2:POKE X,Q AND255:POKE X+1,Q/256:RETURN
#cbm POP_Q:
#cbm   Q=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN
#cbm PEEK_Q:
#cbm   Q=PEEK(X)+PEEK(X+1)*256:RETURN
#cbm PEEK_Q_1:
#cbm   Q=PEEK(X-2)+PEEK(X-1)*256:RETURN
#cbm PEEK_Q_2:
#cbm   Q=PEEK(X-4)+PEEK(X-3)*256:RETURN
#cbm PEEK_Q_Q:
#cbm   Q=PEEK(X-Q*2)+PEEK(X-Q*2+1)*256:RETURN
#cbm PUT_Q:
#cbm   POKE X,Q AND255:POKE X+1,Q/256:RETURN
#cbm PUT_Q_1:
#cbm   POKE X-2,Q AND255:POKE X-1,Q/256:RETURN
#cbm PUT_Q_2:
#cbm   POKE X-4,Q AND255:POKE X-3,Q/256:RETURN

REM memory functions

REM ALLOC(T,L) -> R
REM ALLOC(T,L,M) -> R
REM ALLOC(T,L,M,N) -> R
REM L is value for Z%(R+1)
REM M is value for Z%(R+2), if SZ>2
REM N is value for Z%(R+3), if SZ>3
ALLOC:
  SZ=3
  IF T<6 OR T=9 OR T=12 THEN SZ=2
  IF T=8 OR T=10 OR T=11 THEN SZ=4
  REM PRINT "ALLOC T: "+STR$(T)+", SZ: "+STR$(SZ)+", ZK: "+STR$(ZK)
  U=ZK
  R=ZK
  ALLOC_LOOP:
    IF R=ZI THEN GOTO ALLOC_UNUSED
    REM TODO sanity check that type is 15
    IF ((Z%(R)AND-32)/32)=SZ THEN GOTO ALLOC_MIDDLE
    REM PRINT "ALLOC search: U: "+STR$(U)+", R: "+STR$(R)
    U=R: REM previous set to current
    R=Z%(R+1): REM current set to next
    GOTO ALLOC_LOOP
  ALLOC_MIDDLE:
    REM PRINT "ALLOC_MIDDLE: U: "+STR$(U)+", R: "+STR$(R)
    REM set free pointer (ZK) to next free
    IF R=ZK THEN ZK=Z%(R+1)
    REM set previous free to next free
    IF R<>ZK THEN Z%(U+1)=Z%(R+1)
    GOTO ALLOC_DONE
  ALLOC_UNUSED:
    REM PRINT "ALLOC_UNUSED ZI: "+STR$(ZI)+", U: "+STR$(U)+", R: "+STR$(R)
    IF R+SZ>Z1 THEN GOSUB PR_MEMORY_SUMMARY_SMALL:PRINT "Out of mal memory!":END
    ZI=ZI+SZ
    IF U=R THEN ZK=ZI
    REM set previous free to new memory top
    IF U<>R THEN Z%(U+1)=ZI
    GOTO ALLOC_DONE
  ALLOC_DONE:
    Z%(R)=T+32
    REM set Z%(R+1) to default L
    Z%(R+1)=L
    IF T>5 AND T<>9 THEN Z%(L)=Z%(L)+32: REM value is a Z% idx
    IF SZ>2 THEN Z%(M)=Z%(M)+32:Z%(R+2)=M
    IF SZ>3 THEN Z%(N)=Z%(N)+32:Z%(R+3)=N

    RETURN

REM FREE(AY, SZ) -> nil
FREE:
  REM assumes reference count cleanup already (see RELEASE)
  Z%(AY)=(SZ*32)+15: REM set type(15) and size
  Z%(AY+1)=ZK
  ZK=AY
  IF SZ>=3 THEN Z%(AY+2)=0
  IF SZ=4 THEN Z%(AY+3)=0
  REM TODO: fail if SZ>4
  RETURN


REM RELEASE(AY) -> nil
REM R should not be affected by this call
RELEASE:
  RC=0

  GOTO RELEASE_ONE

  RELEASE_TOP:

  IF RC=0 THEN RETURN

  REM pop next object to release, decrease remaining count
  GOSUB POP_Q:AY=Q
  RC=RC-1

  RELEASE_ONE:
  IF AY=-1 THEN RETURN

  U=Z%(AY)AND 31: REM type
  V=Z%(AY+1): REM main value/reference

  REM set the size
  REM TODO: share with ALLOC calculation
  SZ=3
  IF U<6 OR U=9 OR U=12 THEN SZ=2
  IF U=8 OR U=10 OR U=11 THEN SZ=4

  REM AZ=AY: B=1: GOSUB PR_STR
  REM PRINT "RELEASE AY:"+STR$(AY)+" ["+R$+"] (byte0:"+STR$(Z%(AY))+", SZ:"+STR$(SZ)+")"

  REM sanity check not already freed
  REM MEMORY DEBUGGING:
  REM IF U=15 THEN PRINT "RELEASE of free:"+STR$(AY):END
  REM IF Z%(AY)<15 THEN PRINT "RELEASE of unowned:"+STR$(AY):END

  REM decrease reference count by one
  Z%(AY)=Z%(AY)-32

  REM nil, false, true, empty sequences
  REM MEMORY DEBUGGING:
  REM IF AY<16 AND Z%(AY)<32 THEN PRINT "RELEASE of empty:"+STR$(AY):END
  IF AY<16 THEN GOTO RELEASE_TOP

  REM our reference count is not 0, so don't release
  IF Z%(AY)>=32 GOTO RELEASE_TOP

  REM switch on type
  ON U+1 GOSUB RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_STRING,RELEASE_STRING,RELEASE_SEQ,RELEASE_SEQ,RELEASE_HASH_MAP,RELEASE_SIMPLE,RELEASE_MAL_FUNCTION,RELEASE_MAL_FUNCTION,RELEASE_ATOM,RELEASE_ENV,RELEASE_METADATA

  REM free the current element and continue, SZ already set
  GOSUB FREE
  GOTO RELEASE_TOP

  RELEASE_SIMPLE:
    RETURN
  RELEASE_STRING:
    REM string type, release interned string, then FREE reference
    REM MEMORY DEBUGGING:
    REM IF S%(V)=0 THEN PRINT "RELEASE of free string:"+STR$(S%(V)):END
    S%(V)=S%(V)-1
    IF S%(V)=0 THEN S$(V)="": REM free BASIC string
    REM free the atom itself
    RETURN
  RELEASE_SEQ:
    IF V=0 THEN RETURN
    REM add value and next element to stack
    RC=RC+2
    Q=Z%(AY+2):GOSUB PUSH_Q
    Q=V:GOSUB PUSH_Q
    RETURN
  RELEASE_HASH_MAP:
    IF V=0 THEN RETURN
    REM add key, value and next element to stack
    RC=RC+3
    Q=Z%(AY+2):GOSUB PUSH_Q
    Q=Z%(AY+3):GOSUB PUSH_Q
    Q=V:GOSUB PUSH_Q
    RETURN
  RELEASE_ATOM:
    REM add contained/referred value
    RC=RC+1
    Q=V:GOSUB PUSH_Q
    REM free the atom itself
    RETURN
  RELEASE_MAL_FUNCTION:
    REM add ast, params and environment to stack
    RC=RC+3
    Q=V:GOSUB PUSH_Q
    Q=Z%(AY+2):GOSUB PUSH_Q
    Q=Z%(AY+3):GOSUB PUSH_Q
    REM free the current 3 element mal_function
    RETURN
  RELEASE_ENV:
    REM add the hashmap data to the stack
    RC=RC+1
    Q=V:GOSUB PUSH_Q
    REM if outer set, add outer env to stack
    IF Z%(AY+2)<>0 THEN RC=RC+1:Q=Z%(AY+2):GOSUB PUSH_Q
    RETURN
  RELEASE_METADATA:
    REM add object and metadata object
    RC=RC+2
    Q=V:GOSUB PUSH_Q
    Q=Z%(AY+2):GOSUB PUSH_Q
    RETURN


REM INC_REF_R(R) -> R
REM   - return R with 1 ref cnt increase
REM   - call with GOTO to return at caller callsite
REM   - call with GOSUB to return to caller
INC_REF_R:
  Z%(R)=Z%(R)+32
  RETURN

REM RETURN_TRUE_FALSE(R) -> R
REM   - take BASIC true/false R, return mal true/false R with ref cnt
REM   - called with GOTO as a return RETURN
RETURN_TRUE_FALSE:
  IF R THEN R=4
  IF R=0 THEN R=2
  GOTO INC_REF_R


REM release stack functions

#qbasic PEND_A_LV:
#qbasic   Y=Y+1:Y%(Y,0)=A:Y%(Y,1)=LV:RETURN
#qbasic
#qbasic REM RELEASE_PEND(LV) -> nil
#qbasic RELEASE_PEND:
#qbasic   IF Y<0 THEN RETURN
#qbasic   IF Y%(Y,1)<=LV THEN RETURN
#qbasic   REM PRINT "RELEASE_PEND releasing:"+STR$(Y%(Y,0))
#qbasic   AY=Y%(Y,0):GOSUB RELEASE
#qbasic   Y=Y-1
#qbasic   GOTO RELEASE_PEND

#cbm PEND_A_LV:
#cbm   Y=Y+4:POKE Y,A AND255:POKE Y+1,A/256
#cbm         POKE Y+2,LV AND255:POKE Y+3,LV/256:RETURN
#cbm
#cbm REM RELEASE_PEND(LV) -> nil
#cbm RELEASE_PEND:
#cbm   IF Y<Z4 THEN RETURN
#cbm   IF (PEEK(Y+2)+PEEK(Y+3)*256)<=LV THEN RETURN
#cbm   REM PRINT "RELEASE_PEND releasing:"+STR$(Y%(Y,0))
#cbm   AY=(PEEK(Y)+PEEK(Y+1)*256):GOSUB RELEASE
#cbm   Y=Y-4
#cbm   GOTO RELEASE_PEND


#cbm DIM_MEMORY:
#cbm   T=FRE(0)
#cbm
#cbm   Z1=8191+1424: REM Z% (boxed memory) size (2 bytes each)
#cbm   Z2=199: REM S$/S% (string memory) size (3+2 bytes each)
#cbm   Z3=49152: REM X starting point at $C000 (2 bytes each)
#cbm   Z4=52992: REM Y starting point at $CF00 (4 bytes each)
#cbm
#cbm   REM TODO: for performance, define all/most non-array variables here
#cbm   REM so that the array area doesn't have to be shifted down everytime
#cbm   REM a new non-array variable is defined
#cbm
#cbm   REM boxed element memory
#cbm   DIM Z%(Z1): REM TYPE ARRAY
#cbm
#cbm   REM string memory storage
#cbm   S=0:DIM S$(Z2):DIM S%(Z2)
#cbm
#cbm   REM call/logic stack
#cbm   X=Z3-2: REM stack of 1920 Z% indexes at $C000
#cbm
#cbm   REM pending release stack
#cbm   Y=Z4-4: REM stack of 64 Y% indexes/levels at $CF00
#cbm
#cbm   RETURN

INIT_MEMORY:
  GOSUB DIM_MEMORY

  REM global error state
  REM  -2 : no error
  REM  -1 : string error in E$
  REM >=0 : pointer to error object
  ER=-2
  E$=""

  REM Predefine nil, false, true, and an empty sequences
  FOR I=0 TO 15:Z%(I)=0:NEXT I
  Z%(0)=32: REM nil
  Z%(2)=1+32: REM false
  Z%(4)=1+32:Z%(5)=1: REM true
  Z%(6)=6+32: REM emtpy list
  Z%(9)=7+32: REM empty vector
  Z%(12)=8+32: REM empty hash-map

  REM start of unused memory
  ZI=16

  REM start of free list
  ZK=16

  REM start of time clock
  #cbm BT=TI
  #qbasic BT#=TIMER(0.001)

  RETURN
Commit	Line	Data
d7a6c2d6	1	REM Memory layout:
7895453b	2	REM
d7a6c2d6 JM	3	REM type bytes
	4	REM ---------- ----------
	5	REM nil ref/ 0 \| 0 \| \|
	6	REM false ref/ 1 \| 0 \| \|
	7	REM true ref/ 1 \| 1 \| \|
	8	REM integer ref/ 2 \| int \| \|
	9	REM float ref/ 3 \| ??? \| \|
	10	REM string/kw ref/ 4 \| S$ idx \| \|
	11	REM symbol ref/ 5 \| S$ idx \| \|
	12	REM list ref/ 6 \| next Z% idx \| val Z% idx \|
	13	REM vector ref/ 7 \| next Z% idx \| val Z% idx \|
	14	REM hashmap ref/ 8 \| next Z% idx \| key Z% idx \| val Z% idx
	15	REM function ref/ 9 \| fn idx \| \|
	16	REM mal function ref/10 \| body Z% idx \| param Z% idx \| env Z% idx
	17	REM macro fn ref/11 \| body Z% idx \| param Z% idx \| env Z% idx
	18	REM atom ref/12 \| val Z% idx \| \|
	19	REM environment ref/13 \| hmap Z% idx \| outer Z% idx \|
	20	REM metadata ref/14 \| obj Z% idx \| meta Z% idx \|
	21	REM FREE sz/15 \| next Z% idx \| \|
	22	REM
7895453b	23	REM Locations 0-15 are for constant/persistent values:
d7a6c2d6 JM	24	REM 0: nil
	25	REM 2: false
	26	REM 4: true
	27	REM 6: empty list
	28	REM 9: empty vector
	29	REM 12: empty hash-map
	30
4a445e84 JM	31	REM Note: DIM_MEMORY for C64 BASIC and the INIT_MEMORY function are at
	32	REM end of this file for efficiency on C64. The most commonly used
	33	REM function should be at the top since C64 BASIC scans line numbers
	34	REM for every GOTO/GOSUB. On the other hand, QBasic requires that
	35	REM arrays are dimensioned at the top of the file, not just as the
	36	REM first operation on that array so DIM_MEMORY for QBasic is here at
	37	REM the top.
	38
	39	#qbasic DIM_MEMORY:
	40	#qbasic T=0
	41	#qbasic
	42	#qbasic Z1=8191+1424: REM Z% (boxed memory) size (2 bytes each)
	43	#qbasic Z2=199: REM S$/S% (string memory) size (3+2 bytes each)
	44	#qbasic Z3=200: REM X% (call stack) size (2 bytes each)
	45	#qbasic Z4=64: REM Y% (release stack) size (4 bytes each)
	46	#qbasic
	47	#qbasic REM boxed element memory
	48	#qbasic DIM Z%(Z1): REM TYPE ARRAY
	49	#qbasic
	50	#qbasic REM string memory storage
	51	#qbasic S=0:DIM S$(Z2):DIM S%(Z2)
	52	#qbasic
	53	#qbasic REM call/logic stack
	54	#qbasic X=-1:DIM X%(Z3): REM stack of Z% indexes
	55	#qbasic
	56	#qbasic REM pending release stack
	57	#qbasic Y=-1:DIM Y%(Z4,1): REM stack of Z% indexes and level/LV values
	58	#qbasic
	59	#qbasic RETURN
d7a6c2d6 JM	60
	61	REM stack functions
	62
	63	#qbasic PUSH_A:
	64	#qbasic X=X+1:X%(X)=A:RETURN
	65	#qbasic POP_A:
	66	#qbasic A=X%(X):X=X-1:RETURN
7895453b	67	#qbasic
d7a6c2d6 JM	68	#qbasic PUSH_R:
	69	#qbasic X=X+1:X%(X)=R:RETURN
	70	#qbasic POP_R:
	71	#qbasic R=X%(X):X=X-1:RETURN
7895453b	72	#qbasic
d7a6c2d6 JM	73	#qbasic PUSH_Q:
	74	#qbasic X=X+1:X%(X)=Q:RETURN
	75	#qbasic POP_Q:
	76	#qbasic Q=X%(X):X=X-1:RETURN
	77	#qbasic PEEK_Q:
	78	#qbasic Q=X%(X):RETURN
	79	#qbasic PEEK_Q_1:
	80	#qbasic Q=X%(X-1):RETURN
	81	#qbasic PEEK_Q_2:
	82	#qbasic Q=X%(X-2):RETURN
	83	#qbasic PEEK_Q_Q:
	84	#qbasic Q=X%(X-Q):RETURN
	85	#qbasic PUT_Q:
	86	#qbasic X%(X)=Q:RETURN
	87	#qbasic PUT_Q_1:
	88	#qbasic X%(X-1)=Q:RETURN
	89	#qbasic PUT_Q_2:
	90	#qbasic X%(X-2)=Q:RETURN
	91
	92	#cbm PUSH_A:
	93	#cbm X=X+2:POKE X,A AND255:POKE X+1,A/256:RETURN
	94	#cbm POP_A:
	95	#cbm A=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN
7895453b	96	#cbm
d7a6c2d6 JM	97	#cbm PUSH_R:
	98	#cbm X=X+2:POKE X,R AND255:POKE X+1,R/256:RETURN
	99	#cbm POP_R:
	100	#cbm R=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN
7895453b	101	#cbm
d7a6c2d6 JM	102	#cbm PUSH_Q:
	103	#cbm X=X+2:POKE X,Q AND255:POKE X+1,Q/256:RETURN
	104	#cbm POP_Q:
	105	#cbm Q=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN
	106	#cbm PEEK_Q:
	107	#cbm Q=PEEK(X)+PEEK(X+1)*256:RETURN
	108	#cbm PEEK_Q_1:
	109	#cbm Q=PEEK(X-2)+PEEK(X-1)*256:RETURN
	110	#cbm PEEK_Q_2:
	111	#cbm Q=PEEK(X-4)+PEEK(X-3)*256:RETURN
	112	#cbm PEEK_Q_Q:
	113	#cbm Q=PEEK(X-Q2)+PEEK(X-Q2+1)*256:RETURN
	114	#cbm PUT_Q:
	115	#cbm POKE X,Q AND255:POKE X+1,Q/256:RETURN
	116	#cbm PUT_Q_1:
	117	#cbm POKE X-2,Q AND255:POKE X-1,Q/256:RETURN
	118	#cbm PUT_Q_2:
	119	#cbm POKE X-4,Q AND255:POKE X-3,Q/256:RETURN
	120
	121	REM memory functions
	122
	123	REM ALLOC(T,L) -> R
	124	REM ALLOC(T,L,M) -> R
	125	REM ALLOC(T,L,M,N) -> R
	126	REM L is value for Z%(R+1)
	127	REM M is value for Z%(R+2), if SZ>2
	128	REM N is value for Z%(R+3), if SZ>3
	129	ALLOC:
	130	SZ=3
	131	IF T<6 OR T=9 OR T=12 THEN SZ=2
	132	IF T=8 OR T=10 OR T=11 THEN SZ=4
	133	REM PRINT "ALLOC T: "+STR$(T)+", SZ: "+STR$(SZ)+", ZK: "+STR$(ZK)
	134	U=ZK
	135	R=ZK
	136	ALLOC_LOOP:
	137	IF R=ZI THEN GOTO ALLOC_UNUSED
	138	REM TODO sanity check that type is 15
	139	IF ((Z%(R)AND-32)/32)=SZ THEN GOTO ALLOC_MIDDLE
	140	REM PRINT "ALLOC search: U: "+STR$(U)+", R: "+STR$(R)
	141	U=R: REM previous set to current
	142	R=Z%(R+1): REM current set to next
	143	GOTO ALLOC_LOOP
	144	ALLOC_MIDDLE:
	145	REM PRINT "ALLOC_MIDDLE: U: "+STR$(U)+", R: "+STR$(R)
	146	REM set free pointer (ZK) to next free
	147	IF R=ZK THEN ZK=Z%(R+1)
	148	REM set previous free to next free
	149	IF R<>ZK THEN Z%(U+1)=Z%(R+1)
	150	GOTO ALLOC_DONE
	151	ALLOC_UNUSED:
	152	REM PRINT "ALLOC_UNUSED ZI: "+STR$(ZI)+", U: "+STR$(U)+", R: "+STR$(R)
7895453b	153	IF R+SZ>Z1 THEN GOSUB PR_MEMORY_SUMMARY_SMALL:PRINT "Out of mal memory!":END
d7a6c2d6 JM	154	ZI=ZI+SZ
	155	IF U=R THEN ZK=ZI
	156	REM set previous free to new memory top
	157	IF U<>R THEN Z%(U+1)=ZI
	158	GOTO ALLOC_DONE
	159	ALLOC_DONE:
	160	Z%(R)=T+32
	161	REM set Z%(R+1) to default L
	162	Z%(R+1)=L
	163	IF T>5 AND T<>9 THEN Z%(L)=Z%(L)+32: REM value is a Z% idx
	164	IF SZ>2 THEN Z%(M)=Z%(M)+32:Z%(R+2)=M
	165	IF SZ>3 THEN Z%(N)=Z%(N)+32:Z%(R+3)=N
	166
	167	RETURN
	168
	169	REM FREE(AY, SZ) -> nil
	170	FREE:
	171	REM assumes reference count cleanup already (see RELEASE)
	172	Z%(AY)=(SZ*32)+15: REM set type(15) and size
	173	Z%(AY+1)=ZK
	174	ZK=AY
	175	IF SZ>=3 THEN Z%(AY+2)=0
	176	IF SZ=4 THEN Z%(AY+3)=0
	177	REM TODO: fail if SZ>4
	178	RETURN
	179
	180
	181	REM RELEASE(AY) -> nil
	182	REM R should not be affected by this call
	183	RELEASE:
	184	RC=0
	185
	186	GOTO RELEASE_ONE
	187
	188	RELEASE_TOP:
	189
	190	IF RC=0 THEN RETURN
	191
	192	REM pop next object to release, decrease remaining count
	193	GOSUB POP_Q:AY=Q
	194	RC=RC-1
	195
	196	RELEASE_ONE:
	197	IF AY=-1 THEN RETURN
	198
	199	U=Z%(AY)AND 31: REM type
	200	V=Z%(AY+1): REM main value/reference
	201
	202	REM set the size
	203	REM TODO: share with ALLOC calculation
	204	SZ=3
	205	IF U<6 OR U=9 OR U=12 THEN SZ=2
	206	IF U=8 OR U=10 OR U=11 THEN SZ=4
	207
	208	REM AZ=AY: B=1: GOSUB PR_STR
	209	REM PRINT "RELEASE AY:"+STR$(AY)+" ["+R$+"] (byte0:"+STR$(Z%(AY))+", SZ:"+STR$(SZ)+")"
	210
	211	REM sanity check not already freed
7895453b JM	212	REM MEMORY DEBUGGING:
	213	REM IF U=15 THEN PRINT "RELEASE of free:"+STR$(AY):END
	214	REM IF Z%(AY)<15 THEN PRINT "RELEASE of unowned:"+STR$(AY):END
d7a6c2d6 JM	215
	216	REM decrease reference count by one
	217	Z%(AY)=Z%(AY)-32
	218
	219	REM nil, false, true, empty sequences
7895453b JM	220	REM MEMORY DEBUGGING:
7895453b JM	221	REM IF AY<16 AND Z%(AY)<32 THEN PRINT "RELEASE of empty:"+STR$(AY):END
d7a6c2d6 JM	222	IF AY<16 THEN GOTO RELEASE_TOP
	223
	224	REM our reference count is not 0, so don't release
	225	IF Z%(AY)>=32 GOTO RELEASE_TOP
	226
	227	REM switch on type
	228	ON U+1 GOSUB RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_STRING,RELEASE_STRING,RELEASE_SEQ,RELEASE_SEQ,RELEASE_HASH_MAP,RELEASE_SIMPLE,RELEASE_MAL_FUNCTION,RELEASE_MAL_FUNCTION,RELEASE_ATOM,RELEASE_ENV,RELEASE_METADATA
	229
	230	REM free the current element and continue, SZ already set
	231	GOSUB FREE
	232	GOTO RELEASE_TOP
	233
	234	RELEASE_SIMPLE:
	235	RETURN
	236	RELEASE_STRING:
	237	REM string type, release interned string, then FREE reference
7895453b JM	238	REM MEMORY DEBUGGING:
7895453b JM	239	REM IF S%(V)=0 THEN PRINT "RELEASE of free string:"+STR$(S%(V)):END
d7a6c2d6 JM	240	S%(V)=S%(V)-1
	241	IF S%(V)=0 THEN S$(V)="": REM free BASIC string
	242	REM free the atom itself
	243	RETURN
	244	RELEASE_SEQ:
	245	IF V=0 THEN RETURN
	246	REM add value and next element to stack
	247	RC=RC+2
	248	Q=Z%(AY+2):GOSUB PUSH_Q
	249	Q=V:GOSUB PUSH_Q
	250	RETURN
	251	RELEASE_HASH_MAP:
	252	IF V=0 THEN RETURN
	253	REM add key, value and next element to stack
	254	RC=RC+3
	255	Q=Z%(AY+2):GOSUB PUSH_Q
	256	Q=Z%(AY+3):GOSUB PUSH_Q
	257	Q=V:GOSUB PUSH_Q
	258	RETURN
	259	RELEASE_ATOM:
	260	REM add contained/referred value
	261	RC=RC+1
	262	Q=V:GOSUB PUSH_Q
	263	REM free the atom itself
	264	RETURN
	265	RELEASE_MAL_FUNCTION:
	266	REM add ast, params and environment to stack
	267	RC=RC+3
	268	Q=V:GOSUB PUSH_Q
	269	Q=Z%(AY+2):GOSUB PUSH_Q
	270	Q=Z%(AY+3):GOSUB PUSH_Q
	271	REM free the current 3 element mal_function
	272	RETURN
	273	RELEASE_ENV:
	274	REM add the hashmap data to the stack
	275	RC=RC+1
	276	Q=V:GOSUB PUSH_Q
	277	REM if outer set, add outer env to stack
	278	IF Z%(AY+2)<>0 THEN RC=RC+1:Q=Z%(AY+2):GOSUB PUSH_Q
	279	RETURN
	280	RELEASE_METADATA:
	281	REM add object and metadata object
	282	RC=RC+2
	283	Q=V:GOSUB PUSH_Q
	284	Q=Z%(AY+2):GOSUB PUSH_Q
	285	RETURN
	286
	287
4202ef7b JM	288	REM INC_REF_R(R) -> R
	289	REM - return R with 1 ref cnt increase
	290	REM - call with GOTO to return at caller callsite
	291	REM - call with GOSUB to return to caller
	292	INC_REF_R:
	293	Z%(R)=Z%(R)+32
	294	RETURN
	295
	296	REM RETURN_TRUE_FALSE(R) -> R
	297	REM - take BASIC true/false R, return mal true/false R with ref cnt
	298	REM - called with GOTO as a return RETURN
	299	RETURN_TRUE_FALSE:
	300	IF R THEN R=4
	301	IF R=0 THEN R=2
	302	GOTO INC_REF_R
	303
	304
d7a6c2d6 JM	305	REM release stack functions
	306
	307	#qbasic PEND_A_LV:
	308	#qbasic Y=Y+1:Y%(Y,0)=A:Y%(Y,1)=LV:RETURN
	309	#qbasic
	310	#qbasic REM RELEASE_PEND(LV) -> nil
	311	#qbasic RELEASE_PEND:
	312	#qbasic IF Y<0 THEN RETURN
	313	#qbasic IF Y%(Y,1)<=LV THEN RETURN
	314	#qbasic REM PRINT "RELEASE_PEND releasing:"+STR$(Y%(Y,0))
	315	#qbasic AY=Y%(Y,0):GOSUB RELEASE
	316	#qbasic Y=Y-1
	317	#qbasic GOTO RELEASE_PEND
	318
	319	#cbm PEND_A_LV:
	320	#cbm Y=Y+4:POKE Y,A AND255:POKE Y+1,A/256
	321	#cbm POKE Y+2,LV AND255:POKE Y+3,LV/256:RETURN
	322	#cbm
	323	#cbm REM RELEASE_PEND(LV) -> nil
	324	#cbm RELEASE_PEND:
	325	#cbm IF Y<Z4 THEN RETURN
	326	#cbm IF (PEEK(Y+2)+PEEK(Y+3)*256)<=LV THEN RETURN
	327	#cbm REM PRINT "RELEASE_PEND releasing:"+STR$(Y%(Y,0))
	328	#cbm AY=(PEEK(Y)+PEEK(Y+1)*256):GOSUB RELEASE
	329	#cbm Y=Y-4
	330	#cbm GOTO RELEASE_PEND
	331
	332
d7a6c2d6	333
4a445e84 JM	334	#cbm DIM_MEMORY:
	335	#cbm T=FRE(0)
	336	#cbm
	337	#cbm Z1=8191+1424: REM Z% (boxed memory) size (2 bytes each)
	338	#cbm Z2=199: REM S$/S% (string memory) size (3+2 bytes each)
	339	#cbm Z3=49152: REM X starting point at $C000 (2 bytes each)
	340	#cbm Z4=52992: REM Y starting point at $CF00 (4 bytes each)
	341	#cbm
	342	#cbm REM TODO: for performance, define all/most non-array variables here
	343	#cbm REM so that the array area doesn't have to be shifted down everytime
	344	#cbm REM a new non-array variable is defined
	345	#cbm
	346	#cbm REM boxed element memory
	347	#cbm DIM Z%(Z1): REM TYPE ARRAY
	348	#cbm
	349	#cbm REM string memory storage
	350	#cbm S=0:DIM S$(Z2):DIM S%(Z2)
	351	#cbm
	352	#cbm REM call/logic stack
	353	#cbm X=Z3-2: REM stack of 1920 Z% indexes at $C000
	354	#cbm
	355	#cbm REM pending release stack
	356	#cbm Y=Z4-4: REM stack of 64 Y% indexes/levels at $CF00
	357	#cbm
	358	#cbm RETURN
	359
	360	INIT_MEMORY:
	361	GOSUB DIM_MEMORY
d7a6c2d6 JM	362
	363	REM global error state
	364	REM -2 : no error
	365	REM -1 : string error in E$
	366	REM >=0 : pointer to error object
	367	ER=-2
	368	E$=""
	369
d7a6c2d6 JM	370	REM Predefine nil, false, true, and an empty sequences
	371	FOR I=0 TO 15:Z%(I)=0:NEXT I
	372	Z%(0)=32: REM nil
	373	Z%(2)=1+32: REM false
	374	Z%(4)=1+32:Z%(5)=1: REM true
	375	Z%(6)=6+32: REM emtpy list
	376	Z%(9)=7+32: REM empty vector
	377	Z%(12)=8+32: REM empty hash-map
	378
	379	REM start of unused memory
	380	ZI=16
	381
	382	REM start of free list
	383	ZK=16
	384
4a445e84	385	REM start of time clock
47bcc4c0 JM	386	#cbm BT=TI
47bcc4c0 JM	387	#qbasic BT#=TIMER(0.001)
d7a6c2d6 JM	388
	389	RETURN
	390
	391