basic/types.in.bas

   1 REM general functions
   2
   3 REM TYPE_A(A) -> T
   4 TYPE_A:
   5   T=Z%(A)AND 31
   6   RETURN
   7
   8 REM TYPE_F(F) -> T
   9 TYPE_F:
  10   T=Z%(F)AND 31
  11   RETURN
  12
  13 REM EQUAL_Q(A, B) -> R
  14 EQUAL_Q:
  15   ED=0: REM recursion depth
  16   R=-1: REM return value
  17
  18   EQUAL_Q_RECUR:
  19
  20   REM push A and B
  21   GOSUB PUSH_A
  22   Q=B:GOSUB PUSH_Q
  23   ED=ED+1
  24
  25   GOSUB TYPE_A
  26   T2=Z%(B)AND 31
  27   IF T>5 AND T<8 AND T2>5 AND T2<8 THEN GOTO EQUAL_Q_SEQ
  28   IF T=8 AND T2=8 THEN GOTO EQUAL_Q_HM
  29
  30   IF T<>T2 OR Z%(A+1)<>Z%(B+1) THEN R=0
  31   GOTO EQUAL_Q_DONE
  32
  33   EQUAL_Q_SEQ:
  34     IF Z%(A+1)=0 AND Z%(B+1)=0 THEN GOTO EQUAL_Q_DONE
  35     IF Z%(A+1)=0 OR Z%(B+1)=0 THEN R=0:GOTO EQUAL_Q_DONE
  36
  37     REM compare the elements
  38     A=Z%(A+2):B=Z%(B+2)
  39     GOTO EQUAL_Q_RECUR
  40
  41   EQUAL_Q_SEQ_CONTINUE:
  42     REM next elements of the sequences
  43     GOSUB PEEK_Q_1:A=Q
  44     GOSUB PEEK_Q:B=Q
  45     A=Z%(A+1):B=Z%(B+1)
  46     Q=A:GOSUB PUT_Q_1
  47     Q=B:GOSUB PUT_Q
  48     GOTO EQUAL_Q_SEQ
  49
  50   EQUAL_Q_HM:
  51     R=0
  52     GOTO EQUAL_Q_DONE
  53
  54   EQUAL_Q_DONE:
  55     REM pop current A and B
  56     GOSUB POP_Q
  57     GOSUB POP_Q
  58     ED=ED-1
  59     IF R>-1 AND ED>0 THEN GOTO EQUAL_Q_DONE: REM unwind
  60     IF ED=0 AND R=-1 THEN R=1
  61     IF ED=0 THEN RETURN
  62     GOTO EQUAL_Q_SEQ_CONTINUE
  63
  64 REM string functions
  65
  66 REM STRING(B$, T) -> R
  67 REM intern string and allocate reference (return Z% index)
  68 STRING:
  69   IF S=0 THEN GOTO STRING_NOT_FOUND
  70
  71   REM search for matching string in S$
  72   I=0
  73   STRING_FIND_LOOP:
  74     IF I>S-1 THEN GOTO STRING_NOT_FOUND
  75     IF S%(I)>0 AND B$=S$(I) THEN GOTO STRING_DONE
  76     I=I+1
  77     GOTO STRING_FIND_LOOP
  78
  79   STRING_NOT_FOUND:
  80     I=S-1
  81     STRING_FIND_GAP_LOOP:
  82       REM TODO: don't search core function names (store position)
  83       IF I=-1 THEN GOTO STRING_NEW
  84       IF S%(I)=0 THEN GOTO STRING_SET
  85       I=I-1
  86       GOTO STRING_FIND_GAP_LOOP
  87
  88   STRING_NEW:
  89     I=S
  90     S=S+1
  91     REM fallthrough
  92
  93   STRING_SET:
  94     S$(I)=B$
  95     REM fallthrough
  96
  97   STRING_DONE:
  98     S%(I)=S%(I)+1
  99     L=I:GOSUB ALLOC
 100     RETURN
 101
 102 REM REPLACE(R$, S1$, S2$) -> R$
 103 REPLACE:
 104   T3$=R$
 105   R$=""
 106   I=1
 107   J=LEN(T3$)
 108   REPLACE_LOOP:
 109     IF I>J THEN RETURN
 110     C$=MID$(T3$,I,LEN(S1$))
 111     IF C$=S1$ THEN R$=R$+S2$:I=I+LEN(S1$)
 112     IF C$<>S1$ THEN R$=R$+MID$(T3$,I,1):I=I+1
 113     GOTO REPLACE_LOOP
 114
 115
 116 REM sequence functions
 117
 118 REM FORCE_SEQ_TYPE(A,T) -> R
 119 FORCE_SEQ_TYPE:
 120   REM if it's already the right type, inc ref cnt and return it
 121   IF (Z%(A)AND 31)=T THEN R=A:GOTO INC_REF_R
 122   REM if it's empty, return the empty sequence match T
 123   IF A<16 THEN R=(T-4)*3:GOTO INC_REF_R
 124   REM otherwise, copy first element to turn it into correct type
 125   B=Z%(A+2): REM value to copy
 126   L=Z%(A+1):M=B:GOSUB ALLOC: REM T already set
 127   IF Z%(A+1)=0 THEN RETURN
 128   RETURN
 129
 130 REM MAP_LOOP_START(T):
 131 REM   - setup stack for map loop
 132 MAP_LOOP_START:
 133   REM point to empty sequence to start off
 134   R=(T-4)*3: REM calculate location of empty seq
 135
 136   GOSUB PUSH_R: REM push return ptr
 137   GOSUB PUSH_R: REM push empty ptr
 138   GOSUB PUSH_R: REM push current ptr
 139   GOTO INC_REF_R
 140
 141 REM MAP_LOOP_UPDATE(C,M):
 142 REM MAP_LOOP_UPDATE(C,M,N):
 143 REM  - called after M (and N if T=8) are set
 144 REM  - C indicates whether to free M (and N if T=8)
 145 REM  - update the structure of the return sequence
 146 MAP_LOOP_UPDATE:
 147   GOSUB PEEK_Q_1:L=Q: REM empty ptr
 148
 149   GOSUB ALLOC: REM allocate new sequence element
 150
 151   REM sequence took ownership
 152   AY=L:GOSUB RELEASE
 153   IF C THEN AY=M:GOSUB RELEASE
 154   IF C AND T=8 THEN AY=N:GOSUB RELEASE
 155
 156   REM if not first element, set current next to point to new element
 157   GOSUB PEEK_Q
 158   IF Q>14 THEN Z%(Q+1)=R
 159   REM if first element, set return to new element
 160   IF Q<15 THEN Q=R:GOSUB PUT_Q_2
 161   Q=R:GOSUB PUT_Q: REM update current ptr to new element
 162
 163   RETURN
 164
 165 REM MAP_LOOP_DONE() -> R
 166 REM   - cleanup stack and set return value
 167 MAP_LOOP_DONE:
 168   GOSUB POP_Q: REM pop current ptr
 169   GOSUB POP_Q: REM pop empty ptr
 170   GOSUB POP_R: REM pop return ptr
 171   RETURN
 172
 173
 174 REM LIST_Q(A) -> R
 175 LIST_Q:
 176   R=0
 177   GOSUB TYPE_A
 178   IF T=6 THEN R=1
 179   RETURN
 180
 181 REM EMPTY_Q(A) -> R
 182 EMPTY_Q:
 183   R=0
 184   IF Z%(A+1)=0 THEN R=1
 185   RETURN
 186
 187 REM COUNT(A) -> R
 188 REM - returns length of list, not a Z% index
 189 COUNT:
 190   GOSUB PUSH_A
 191   R=-1
 192   DO_COUNT_LOOP:
 193     R=R+1
 194     IF Z%(A+1)<>0 THEN A=Z%(A+1):GOTO DO_COUNT_LOOP
 195   GOSUB POP_A
 196   RETURN
 197
 198 REM LAST(A) -> R
 199 LAST:
 200   REM TODO check that actually a list/vector
 201   IF Z%(A+1)=0 THEN R=0:RETURN: REM empty seq, return nil
 202   W=0
 203   LAST_LOOP:
 204     IF Z%(A+1)=0 THEN GOTO LAST_DONE: REM end, return previous value
 205     W=A: REM current becomes previous entry
 206     A=Z%(A+1): REM next entry
 207     GOTO LAST_LOOP
 208   LAST_DONE:
 209     R=Z%(W+2)
 210     GOTO INC_REF_R
 211
 212 REM SLICE(A,B,C) -> R
 213 REM make copy of sequence A from index B to C
 214 REM returns R6 as reference to last element of slice before empty
 215 REM returns A as next element following slice (of original)
 216 SLICE:
 217   I=0
 218   R=6: REM always a list
 219   GOSUB INC_REF_R
 220   R6=-1: REM last list element before empty
 221   W=R: REM temporary for return as R
 222   REM advance A to position B
 223   SLICE_FIND_B:
 224     IF I<B AND Z%(A+1)<>0 THEN A=Z%(A+1):I=I+1:GOTO SLICE_FIND_B
 225   SLICE_LOOP:
 226     REM if current position is C, then return
 227     IF C<>-1 AND I>=C THEN R=W:RETURN
 228     REM if we reached end of A, then return
 229     IF Z%(A+1)=0 THEN R=W:RETURN
 230     REM allocate new list element with copied value
 231     T=6:L=6:M=Z%(A+2):GOSUB ALLOC
 232     REM sequence took ownership
 233     AY=L:GOSUB RELEASE
 234     REM if not first element, set last to point to new element
 235     IF R6>-1 THEN Z%(R6+1)=R
 236     REM if first element, set return value to new element
 237     IF R6=-1 THEN W=R
 238     R6=R: REM update last list element
 239     REM advance to next element of A
 240     A=Z%(A+1)
 241     I=I+1
 242     GOTO SLICE_LOOP
 243
 244 REM LIST2(B,A) -> R
 245 LIST2:
 246   REM last element is 3 (empty list), second element is A
 247   T=6:L=6:M=A:GOSUB ALLOC
 248
 249   REM first element is B
 250   T=6:L=R:M=B:GOSUB ALLOC
 251   AY=L:GOSUB RELEASE: REM new list takes ownership of previous
 252
 253   RETURN
 254
 255 REM LIST3(C,B,A) -> R
 256 LIST3:
 257   GOSUB LIST2
 258
 259   REM first element is C
 260   T=6:L=R:M=C:GOSUB ALLOC
 261   AY=L:GOSUB RELEASE: REM new list takes ownership of previous
 262
 263   RETURN
 264
 265
 266 REM hashmap functions
 267
 268 REM HASHMAP() -> R
 269 HASHMAP:
 270   REM just point to static empty hash-map
 271   R=12
 272   GOTO INC_REF_R
 273
 274 REM ASSOC1(H, K, C) -> R
 275 ASSOC1:
 276   REM create key/value entry
 277   T=8:L=H:M=K:N=C:GOSUB ALLOC
 278   AY=L:GOSUB RELEASE: REM we took ownership of previous hashmap
 279   RETURN
 280
 281 REM ASSOC1_S(H, B$, C) -> R
 282 ASSOC1_S:
 283   REM add the key string
 284   T=4:GOSUB STRING
 285   K=R:GOSUB ASSOC1
 286   AY=K:GOSUB RELEASE: REM map took ownership of key
 287   RETURN
 288
 289 REM HASHMAP_GET(H, K) -> R
 290 REM   - returns R3 with whether we found it or not
 291 HASHMAP_GET:
 292   B$=S$(Z%(K+1)): REM search key string
 293   R3=0: REM whether found or not (for HASHMAP_CONTAINS)
 294   R=0
 295   HASHMAP_GET_LOOP:
 296     REM no matching key found
 297     IF Z%(H+1)=0 THEN R=0:RETURN
 298     REM get search string is equal to key string we found it
 299     IF B$=S$(Z%(Z%(H+2)+1)) THEN R3=1:R=Z%(H+3):RETURN
 300     REM skip to next key/value
 301     H=Z%(H+1)
 302     GOTO HASHMAP_GET_LOOP
 303
 304 REM HASHMAP_CONTAINS(H, K) -> R
 305 HASHMAP_CONTAINS:
 306   GOSUB HASHMAP_GET
 307   R=R3
 308   RETURN
 309