basic/debug.in.bas

   1 REM CHECK_FREE_LIST() -> P2
   2 CHECK_FREE_LIST:
   3   REM start and accumulator
   4   P1=ZK
   5   P2=0
   6   CHECK_FREE_LIST_LOOP:
   7     IF P1>=ZI THEN RETURN
   8     REM MEMORY DEBUGGING:
   9     REM IF (Z%(P1)AND 31)<>15 THEN PRINT "corrupt free:"+STR$(P1):END
  10     P2=P2+(Z%(P1)AND-32)/32
  11     P1=Z%(P1+1)
  12     GOTO CHECK_FREE_LIST_LOOP
  13
  14 PR_MEMORY_SUMMARY_SMALL:
  15   #cbm P0=FRE(0)
  16
  17   GOSUB CHECK_FREE_LIST
  18   #cbm PRINT "Free:"+STR$(FRE(0))+", ";
  19   PRINT "Values:"+STR$(ZI-1-P2)+", Emptys:";
  20   FOR P=0 TO 4 STEP 2:GOSUB PR_MEMORY_SUMMARY_SMALL_1:NEXT P
  21   FOR P=6 TO 12 STEP 3:GOSUB PR_MEMORY_SUMMARY_SMALL_1:NEXT P
  22   PRINT
  23   RETURN
  24   PR_MEMORY_SUMMARY_SMALL_1:
  25     PRINT STR$(INT(Z%(P)/32))+",";
  26     RETURN
  27
  28 REM REM COUNT_STRINGS() -> P2
  29 REM COUNT_STRINGS:
  30 REM   P1=0
  31 REM   P2=0
  32 REM   COUNT_STRINGS_LOOP:
  33 REM     IF P1>S-1 THEN RETURN
  34 REM     IF S%(P1)>0 THEN P2=P2+1
  35 REM     P1=P1+1
  36 REM     GOTO COUNT_STRINGS_LOOP
  37 REM
  38 REM PR_MEMORY_SUMMARY:
  39 REM   #cbm P0=FRE(0)
  40 REM
  41 REM   PRINT
  42 REM   #cbm PRINT "Free (FRE)   :"+STR$(P0)
  43 REM   GOSUB CHECK_FREE_LIST: REM get count in P2
  44 REM   PRINT "Values (Z%)  :"+STR$(ZI-1-P2)+" /"+STR$(Z1)
  45 REM   REM PRINT "               max:"+STR$(ZI-1);
  46 REM   REM PRINT ", freed:"+STR$(P2)+", after repl_env:"+STR$(ZT)
  47 REM   GOSUB COUNT_STRINGS
  48 REM   PRINT "Strings (S$) :"+STR$(P2)+" /"+STR$(Z2)
  49 REM   #qbasic PRINT "Stack (X%)   :"+STR$(X+1)+" /"+STR$(Z3)
  50 REM   #cbm PRINT "Stack        :"+STR$(X+2-Z3)+" / 1920"
  51 REM   RETURN
  52 REM
  53 REM #cbm PR_MEMORY_MAP:
  54 REM   #cbm PRINT
  55 REM   #cbm P1=PEEK(43)+PEEK(44)*256
  56 REM   #cbm P2=PEEK(45)+PEEK(46)*256
  57 REM   #cbm P3=PEEK(47)+PEEK(48)*256
  58 REM   #cbm P4=PEEK(49)+PEEK(50)*256
  59 REM   #cbm P5=PEEK(51)+PEEK(52)*256
  60 REM   #cbm P6=PEEK(53)+PEEK(54)*256
  61 REM   #cbm P7=PEEK(55)+PEEK(56)*256
  62 REM   #cbm PRINT "BASIC beg.   :"STR$(P1)
  63 REM   #cbm PRINT "Variable beg.:"STR$(P2)
  64 REM   #cbm PRINT "Array beg.   :"STR$(P3)
  65 REM   #cbm PRINT "Array end    :"STR$(P4)
  66 REM   #cbm PRINT "String beg.  :"STR$(P5)
  67 REM   #cbm PRINT "String cur.  :"STR$(P6)
  68 REM   #cbm PRINT "BASIC end    :"STR$(P7)
  69 REM   #cbm PRINT
  70 REM   #cbm PRINT "Program Code :"STR$(P2-P1)
  71 REM   #cbm PRINT "Variables    :"STR$(P3-P2)
  72 REM   #cbm PRINT "Arrays       :"STR$(P4-P3)
  73 REM   #cbm PRINT "String Heap  :"STR$(P7-P5)
  74 REM   #cbm RETURN
  75 REM
  76 REM REM PR_MEMORY_VALUE(I) -> J:
  77 REM REM   - I is memory value to print
  78 REM REM   - I is returned as last byte of value printed
  79 REM REM   - J is returned as type
  80 REM PR_MEMORY_VALUE:
  81 REM   J=Z%(I)AND 31
  82 REM   P3=Z%(I+1)
  83 REM   PRINT " "+STR$(I)+": type:"+STR$(J);
  84 REM   IF J<>15 THEN PRINT ", refs:"+STR$((Z%(I)-J)/32);
  85 REM   IF J=15 THEN PRINT ", size:"+STR$((Z%(I)AND-32)/32);
  86 REM   PRINT ", ["+STR$(Z%(I));+" |"+STR$(P3);
  87 REM   IF J<6 OR J=9 OR J=12 OR J=15 THEN PRINT " | --- | --- ]";:GOTO PR_MEM_SKIP
  88 REM   PRINT " |"+STR$(Z%(I+2));
  89 REM   IF J=6 OR J=7 OR J=13 OR J=14 THEN PRINT " | --- ]";:GOTO PR_MEM_SKIP
  90 REM   PRINT " |"+STR$(Z%(I+3))+" ]";
  91 REM   PR_MEM_SKIP:
  92 REM   PRINT " >> ";
  93 REM   ON J+1 GOTO PR_ENTRY_NIL,PR_ENTRY_BOOL,PR_ENTRY_INT,PR_ENTRY_FLOAT,PR_ENTRY_STR,PR_ENTRY_SYM,PR_ENTRY_LIST,PR_ENTRY_VECTOR,PR_ENTRY_HASH_MAP,PR_ENTRY_FN,PR_ENTRY_MALFN,PR_ENTRY_MAC,PR_ENTRY_ATOM,PR_ENTRY_ENV,PR_ENTRY_META,PR_ENTRY_FREE
  94 REM   PRINT "Unknown type:"+STR$(J):END
  95 REM
  96 REM   PR_ENTRY_NIL:
  97 REM     PRINT "nil"
  98 REM     I=I+1
  99 REM     RETURN
 100 REM   PR_ENTRY_BOOL:
 101 REM     IF P3=0 THEN PRINT "false"
 102 REM     IF P3=1 THEN PRINT "true"
 103 REM     I=I+1
 104 REM     RETURN
 105 REM   PR_ENTRY_INT:
 106 REM   PR_ENTRY_FLOAT:
 107 REM     PRINT STR$(P3)
 108 REM     I=I+1
 109 REM     RETURN
 110 REM   PR_ENTRY_STR:
 111 REM     PRINT "'"+S$(P3)+"'"
 112 REM     I=I+1
 113 REM     RETURN
 114 REM   PR_ENTRY_SYM:
 115 REM     PRINT S$(P3)
 116 REM     I=I+1
 117 REM     RETURN
 118 REM   PR_ENTRY_LIST:
 119 REM     I=I+2
 120 REM     IF I<16 THEN PRINT "()":RETURN
 121 REM     PRINT "(..."+STR$(Z%(I))+" ...)"
 122 REM     RETURN
 123 REM   PR_ENTRY_VECTOR:
 124 REM     I=I+2
 125 REM     IF I<16 THEN PRINT "[]":RETURN
 126 REM     PRINT "[..."+STR$(Z%(I))+" ...]"
 127 REM     RETURN
 128 REM   PR_ENTRY_HASH_MAP:
 129 REM     I=I+3
 130 REM     IF I<16 THEN PRINT "{}":RETURN
 131 REM     IF J=8 THEN PRINT "{... key:"+STR$(Z%(I-1))+", val:"+STR$(Z%(I))+" ...}"
 132 REM     RETURN
 133 REM   PR_ENTRY_FN:
 134 REM     PRINT "#<fn"+STR$(P3)+">"
 135 REM     I=I+1
 136 REM     RETURN
 137 REM   PR_ENTRY_MALFN:
 138 REM   PR_ENTRY_MAC:
 139 REM     IF I=11 THEN PRINT "MACRO ";
 140 REM     PRINT "(fn* param:"+STR$(Z%(I))+", env:"+STR$(Z%(I+1))+")"
 141 REM     I=I+3
 142 REM     RETURN
 143 REM   PR_ENTRY_ATOM:
 144 REM     PRINT "(atom val:"+STR$(P3)+")"
 145 REM     I=I+1
 146 REM     RETURN
 147 REM   PR_ENTRY_ENV:
 148 REM     PRINT "#<env hm:"+STR$(P3)+", outer:"+STR$(Z%(I+2))+">"
 149 REM     I=I+2
 150 REM     RETURN
 151 REM   PR_ENTRY_META:
 152 REM     PRINT "#<meta obj:"+STR$(P3)+", meta:"+STR$(Z%(I+2))+">"
 153 REM     I=I+2
 154 REM     RETURN
 155 REM   PR_ENTRY_FREE:
 156 REM     PRINT "FREE next:"+STR$(P3);
 157 REM     IF I=ZK THEN PRINT " (free list start)";
 158 REM     PRINT
 159 REM     I=I-1+(Z%(I)AND-32)/32
 160 REM     RETURN
 161 REM
 162 REM REM PR_OBJECT(P1) -> nil
 163 REM PR_OBJECT:
 164 REM   RD=0
 165 REM
 166 REM   IF P1=-1 THEN PRINT "  "+STR$(-1)+": ---":RETURN
 167 REM   RD=RD+1
 168 REM   Q=P1:GOSUB PUSH_Q
 169 REM
 170 REM   PR_OBJ_LOOP:
 171 REM     IF RD=0 THEN RETURN
 172 REM     RD=RD-1
 173 REM
 174 REM     GOSUB PEEK_Q:I=Q
 175 REM     REM IF I<15 THEN GOSUB POP_Q:GOTO PR_OBJ_LOOP
 176 REM     GOSUB PR_MEMORY_VALUE
 177 REM     REM J holds type now
 178 REM     GOSUB POP_Q:I=Q
 179 REM
 180 REM     IF J<6 OR J=9 THEN GOTO PR_OBJ_LOOP: REM no contained references
 181 REM     REM reference in first position
 182 REM     IF Z%(I+1)<>0 THEN RD=RD+1:Q=Z%(I+1):GOSUB PUSH_Q
 183 REM     IF J=12 OR J=15 THEN PR_OBJ_LOOP: REM no more reference
 184 REM     REM reference in second position
 185 REM     IF Z%(I+2)<>0 THEN RD=RD+1:Q=Z%(I+2):GOSUB PUSH_Q
 186 REM     IF J=6 OR J=7 OR J=13 OR J=14 THEN PR_OBJ_LOOP: REM no more references
 187 REM     IF Z%(I+3)<>0 THEN RD=RD+1:Q=Z%(I+3):GOSUB PUSH_Q
 188 REM     GOTO PR_OBJ_LOOP
 189 REM
 190 REM REM PR_MEMORY(P1, P2) -> nil
 191 REM PR_MEMORY:
 192 REM   IF P2<P1 THEN P2=ZI-1
 193 REM   PRINT "Values (Z%)"+STR$(P1)+" ->"+STR$(P2);
 194 REM   PRINT " (ZI: "+STR$(ZI)+", ZK: "+STR$(ZK)+"):"
 195 REM   IF P2<P1 THEN PRINT "  ---":GOTO PR_MEMORY_AFTER_VALUES
 196 REM   I=P1
 197 REM   PR_MEMORY_VALUE_LOOP:
 198 REM     IF I>P2 THEN GOTO PR_MEMORY_AFTER_VALUES
 199 REM     GOSUB PR_MEMORY_VALUE
 200 REM     I=I+1
 201 REM     GOTO PR_MEMORY_VALUE_LOOP
 202 REM   PR_MEMORY_AFTER_VALUES:
 203 REM   PRINT "S$ String Memory (S: "+STR$(S)+"):"
 204 REM   IF S<=0 THEN PRINT "  ---":GOTO PR_MEMORY_SKIP_STRINGS
 205 REM   FOR I=0 TO S-1
 206 REM     PRINT " "+STR$(I)+": '"+S$(I)+"'"
 207 REM     NEXT I
 208 REM   PR_MEMORY_SKIP_STRINGS:
 209 REM   PRINT "X% Stack Memory (X: "+STR$(X)+"):"
 210 REM #cbm  IF X<Z3 THEN PRINT "  ---":GOTO PR_MEMORY_SKIP_STACK
 211 REM #cbm  FOR I=Z3 TO X
 212 REM #cbm    PRINT " "+STR$(I)+": "+STR$(PEEK(X)+PEEK(X+1)*256)
 213 REM #cbm    NEXT I
 214 REM #qbasic  IF X<0 THEN PRINT "  ---":GOTO PR_MEMORY_SKIP_STACK
 215 REM #qbasic  FOR I=0 TO X
 216 REM #qbasic    #qbasic PRINT " "+STR$(I)+": "+STR$(X%(I))
 217 REM #qbasic    NEXT I
 218 REM   PR_MEMORY_SKIP_STACK:
 219 REM   RETURN
 220 REM