QB64/QB64-PE
QB64/QB64-PE
1
1
Fork 0
mirror of https://github.com/QB64-Phoenix-Edition/QB64pe.git synced 2024-09-20 04:24:48 +00:00
Code Issues Releases Wiki Activity

Merge pull request #453 from mkilgore/libqb-refactor-part-1

Browse source 
libqb refactor - Part 1
This commit is contained in:
Matt Kilgore 2024-02-15 20:45:35 -05:00 committed by GitHub
commit fb145ee2d3
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
20 changed files with 2775 additions and 2567 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
Makefile
View file

@ -133,7 +133,7 @@ all: $(EXE)
CLEAN_LIST :=
CLEAN_DEP_LIST :=
CXXFLAGS += -w -std=gnu++14
CXXFLAGS += -std=gnu++14
ifeq ($(OS),lnx)
CXXLIBS += -lGL -lGLU -lX11 -lpthread -ldl -lrt
@ -154,7 +154,8 @@ ifeq ($(OS),osx)
endif
endif
QB_QBX_OBJ := $(PATH_INTERNAL_C)/qbx$(TEMP_ID).o
QB_QBX_SRC := $(PATH_INTERNAL_C)/qbx$(TEMP_ID).cpp
QB_QBX_OBJ := $(patsubst %.cpp,%.o,$(QB_QBX_SRC))
$(QB_QBX_OBJ): $(wildcard $(PATH_INTERNAL)/temp$(TEMP_ID)/*.txt)
@ -389,6 +390,10 @@ EXE_OBJS := $(QBLIB) $(EXE_OBJS)
%.o: %.cpp
$(CXX) $(CXXFLAGS) $< -c -o $@
# qbx produces thousands of warnings due to passing NULL for every unused parameter
$(QB_QBX_OBJ): $(QB_QBX_SRC)
$(CXX) $(CXXFLAGS) $< -w -c -o $@
ifeq ($(OS),osx)
%.o: %.mm
$(CXX) $(CXXFLAGS) $< -c -o $@

146
internal/c/common.h
View file

@ -97,126 +97,8 @@
# endif
# define QB_FALSE 0
# define QB_TRUE -1
# define QB_ERROR_NEXT_WITHOUT_FOR 1
# define QB_ERROR_SYNTAX_ERROR 2
# define QB_ERROR_RETURN_WITHOUT_GOSUB 3
# define QB_ERROR_OUT_OF_DATA 4
# define QB_ERROR_ILLEGAL_FUNCTION_CALL 5
# define QB_ERROR_OVERFLOW 6
# define QB_ERROR_OUT_OF_MEMORY 7
# define QB_ERROR_LABEL_NOT_DEFINED 8
# define QB_ERROR_SUBSCRIPT_OUT_OF_RANGE 9
# define QB_ERROR_DUPLICATE_DEFINITION 10
# define QB_ERROR_DIVISION_BY_ZERO 11
# define QB_ERROR_ILLEGAL_IN_DIRECT_MODE 12
# define QB_ERROR_TYPE_MISMATCH 13
# define QB_ERROR_OUT_OF_STRING_SPACE 14
# define QB_ERROR_STRING_FORMULA_TOO_COMPLEX 16
# define QB_ERROR_CANNOT_CONTINUE 17
# define QB_ERROR_FUNCTION_NOT_DEFINED 18
# define QB_ERROR_NO_RESUME 19
# define QB_ERROR_RESUME_WITHOUT_ERROR 20
# define QB_ERROR_DEVICE_TIMEOUT 24
# define QB_ERROR_DEVICE_FAULT 25
# define QB_ERROR_FOR_WITHOUT_NEXT 26
# define QB_ERROR_OUT_OF_PAPER 27
# define QB_ERROR_WHILE_WITHOUT_WEND 29
# define QB_ERROR_WEND_WITHOUT_WHILE 30
# define QB_ERROR_DUPLICATE_LABEL 33
# define QB_ERROR_SUBPROGRAM_NOT_DEFINED 35
# define QB_ERROR_ARGUMENT_COUNT_MISMATCH 37
# define QB_ERROR_ARRAY_NOT_DEFINED 38
# define QB_ERROR_VARIABLE_REQUIRED 40
# define QB_ERROR_FIELD_OVERFLOW 50
# define QB_ERROR_INTERNAL_ERROR 51
# define QB_ERROR_BAD_FILE_NAME_OR_NUMBER 52
# define QB_ERROR_FILE_NOT_FOUND 53
# define QB_ERROR_BAD_FILE_MODE 54
# define QB_ERROR_FILE_ALREADY_OPEN 55
# define QB_ERROR_FIELD_STATEMENT_ACTIVE 56
# define QB_ERROR_DEVICE_IO_ERROR 57
# define QB_ERROR_FILE_ALREADY_EXISTS 58
# define QB_ERROR_BAD_RECORD_LENGTH 59
# define QB_ERROR_DISK_FULL 61
# define QB_ERROR_INPUT_PAST_END_OF_FILE 62
# define QB_ERROR_BAD_RECORD_NUMBER 63
# define QB_ERROR_BAD_FILE_NAME 64
# define QB_ERROR_TOO_MANY_FILES 67
# define QB_ERROR_DEVICE_UNAVAILABLE 68
# define QB_ERROR_COMMUNICATION_BUFFER_OVERFLOW 69
# define QB_ERROR_PERMISSION_DENIED 70
# define QB_ERROR_DISK_NOT_READY 71
# define QB_ERROR_DISK_MEDIA_ERROR 72
# define QB_ERROR_FEATURE_UNAVAILABLE 73
# define QB_ERROR_RENAME_ACROSS_DISKS 74
# define QB_ERROR_PATH_FILE_ACCESS_ERROR 75
# define QB_ERROR_PATH_NOT_FOUND 76
# define QB_ERROR_OUT_OF_STACK_SPACE 256
# define QB_ERROR_OUT_OF_MEMORY_FATAL 257
# define QB_ERROR_INVALID_HANDLE 258
# define QB_ERROR_CANNOT_FIND_DYNAMIC_LIBRARY_FILE 259
# define QB_ERROR_FUNCTION_NOT_FOUND_IN_DYNAMIC_LIBRARY 260
# define QB_ERROR_FUNCTION_NOT_FOUND_IN_DYNAMIC_LIBRARY_261 261
# define QB_ERROR_GL_COMMAND_OUTSIDE_SUB_GL_SCOPE 270
# define QB_ERROR_END_SYSTEM_IN_SUB_GL_SCOPE 271
# define QB_ERROR_MEMORY_REGION_OUT_OF_RANGE 300
# define QB_ERROR_INVALID_SIZE 301
# define QB_ERROR_SOURCE_MEMORY_REGION_OUT_OF_RANGE 302
# define QB_ERROR_DESTINATION_MEMORY_REGION_OUT_OF_RANGE 303
# define QB_ERROR_BOTH_MEMORY_REGIONS_OUT_OF_RANGE 304
# define QB_ERROR_SOURCE_MEMORY_FREED 305
# define QB_ERROR_DESTINATION_MEMORY_FREED 306
# define QB_ERROR_MEMORY_ALREADY_FREED 307
# define QB_ERROR_MEMORY_HAS_BEEN_FREED 308
# define QB_ERROR_MEMORY_NOT_INITIALIZED 309
# define QB_ERROR_SOURCE_MEMORY_NOT_INITIALIZED 310
# define QB_ERROR_DESTINATION_MEMORY_NOT_INITIALIZED 311
# define QB_ERROR_BOTH_MEMORY_NOT_INITIALIZED 312
# define QB_ERROR_BOTH_MEMORY_FREED 313
# define QB_ERROR_ASSERT_FAILED 314
# define QB_ERROR_ASSERT_FAILED_WITH_DESCRIPTION 315
# define QB_ERROR_OUT_OF_MEMORY_FATAL_502 502
# define QB_ERROR_OUT_OF_MEMORY_FATAL_503 503
# define QB_ERROR_OUT_OF_MEMORY_FATAL_504 504
# define QB_ERROR_OUT_OF_MEMORY_FATAL_505 505
# define QB_ERROR_OUT_OF_MEMORY_FATAL_506 506
# define QB_ERROR_OUT_OF_MEMORY_FATAL_507 507
# define QB_ERROR_OUT_OF_MEMORY_FATAL_508 508
# define QB_ERROR_OUT_OF_MEMORY_FATAL_509 509
# define QB_ERROR_OUT_OF_MEMORY_FATAL_510 510
# define QB_ERROR_OUT_OF_MEMORY_FATAL_511 511
# define QB_ERROR_OUT_OF_MEMORY_FATAL_512 512
# define QB_ERROR_OUT_OF_MEMORY_FATAL_513 513
# define QB_ERROR_OUT_OF_MEMORY_FATAL_514 514
# define QB_ERROR_OUT_OF_MEMORY_FATAL_515 515
# define QB_ERROR_OUT_OF_MEMORY_FATAL_516 516
# define QB_ERROR_OUT_OF_MEMORY_FATAL_517 517
# define QB_ERROR_OUT_OF_MEMORY_FATAL_518 518
// QB64 string descriptor structure
struct qbs_field {
int32 fileno;
int64 fileid;
int64 size;
int64 offset;
};
struct qbs {
uint8 *chr; // a 32 bit pointer to the string's data
int32 len; // must be signed for comparisons against signed int32s
uint8 in_cmem; // set to 1 if in the conventional memory DBLOCK
uint16 *cmem_descriptor;
uint16 cmem_descriptor_offset;
uint32 listi; // the index in the list of strings that references it
uint8 tmp; // set to 1 if the string can be deleted immediately after being processed
uint32 tmplisti; // the index in the list of strings that references it
uint8 fixed; // fixed length string
uint8 readonly; // set to 1 if string is read only
qbs_field *field;
};
#include "error_handle.h"
#include "qbs.h"
struct img_struct {
void *lock_offset;
@ -348,28 +230,6 @@ struct device_struct {
# define DEVICETYPE_KEYBOARD 2
# define DEVICETYPE_MOUSE 3
struct mem_block {
ptrszint offset;
ptrszint size;
int64 lock_id; // 64-bit key, must be present at lock's offset or memory region is invalid
ptrszint lock_offset; // pointer to lock
ptrszint type; // https://qb64phoenix.com/qb64wiki/index.php/MEM
ptrszint elementsize;
int32 image;
int32 sound;
};
struct mem_lock {
uint64 id;
int32 type; // required to know what action to take (if any) when a request is made to free the block
// 0=no security (eg. user defined block from _OFFSET)
// 1=C-malloc'ed block
// 2=image
// 3=sub/function scope block
// 4=array
// 5=sound
//---- type specific variables follow ----
void *offset; // used by malloc'ed blocks to free them
};
#include "mem.h"
#endif // INC_COMMON_CPP

2349
internal/c/libqb.cpp
View file

File diff suppressed because it is too large Load diff

33
internal/c/libqb.h
View file

@ -2,14 +2,8 @@
#define INC_LIBQB_H
#include "common.h"
void error(int32 error_number);
extern uint32 new_error;
extern uint32 error_err; //=0;
extern double error_erl; //=0;
extern uint32 error_occurred;
extern uint32 error_goto_line;
extern uint32 error_handling;
extern uint32 error_retry;
#include "cmem.h"
#include "qbs.h"
void sub_shell4(qbs *, int32); //_DONTWAIT & _HIDE
int32 func__source();
@ -29,25 +23,8 @@ void sub__freeimage(int32 i, int32 passed);
int32 func__dest();
int32 func__display();
void qbg_sub_view_print(int32, int32, int32);
qbs *qbs_new(int32, uint8);
qbs *qbs_new_txt(const char *);
qbs *qbs_new_txt_len(const char *, int32_t);
qbs *qbs_add(qbs *, qbs *);
qbs *qbs_set(qbs *, qbs *);
int32 qbs_equal(qbs *str1, qbs *str2);
qbs *func_space(int32 spaces);
void makefit(qbs *text);
qbs *qbs_str(int64 value);
qbs *qbs_str(int32 value);
qbs *qbs_str(int16 value);
qbs *qbs_str(int8 value);
qbs *qbs_str(uint64 value);
qbs *qbs_str(uint32 value);
qbs *qbs_str(uint16 value);
qbs *qbs_str(uint8 value);
qbs *qbs_str(float value);
qbs *qbs_str(double value);
qbs *qbs_str(long double value);
void qbg_sub_window(float, float, float, float, int32);
extern int32 autodisplay;
// GFS forward references
@ -65,8 +42,6 @@ int32 gfs_write(int32 i, int64 position, uint8 *data, int64 size);
int32 gfs_read(int32 i, int64 position, uint8 *data, int64 size);
int64 gfs_read_bytes();
extern uint8 cmem[1114099]; // 16*65535+65535+3 (enough for highest referencable dword in conv memory)
// keyhit cyclic buffer
extern int64 keyhit[8192];
// keyhit specific internal flags: (stored in high 32-bits)
@ -81,8 +56,4 @@ extern int32 port60h_events;
extern int32 window_exists;
extern int32 no_control_characters2;
extern qbs *qbs_lcase(qbs *str);
extern qbs *qbs_ucase(qbs *str);
extern int32 qbs_equal(qbs *str1, qbs *str2);
#endif

11
internal/c/libqb/build.mk
View file

@ -1,10 +1,17 @@
libqb-objs-y += $(PATH_LIBQB)/src/threading.o
libqb-objs-y += $(PATH_LIBQB)/src/buffer.o
libqb-objs-y += $(PATH_LIBQB)/src/command.o
libqb-objs-y += $(PATH_LIBQB)/src/filepath.o
libqb-objs-y += $(PATH_LIBQB)/src/filesystem.o
libqb-objs-y += $(PATH_LIBQB)/src/datetime.o
libqb-objs-y += $(PATH_LIBQB)/src/error_handle.o
libqb-objs-y += $(PATH_LIBQB)/src/mem.o
libqb-objs-y += $(PATH_LIBQB)/src/rounding.o
libqb-objs-y += $(PATH_LIBQB)/src/qbs.o
libqb-objs-y += $(PATH_LIBQB)/src/qbs_str.o
libqb-objs-y += $(PATH_LIBQB)/src/qbs_cmem.o
libqb-objs-y += $(PATH_LIBQB)/src/string_functions.o
libqb-objs-$(DEP_HTTP) += $(PATH_LIBQB)/src/http.o
libqb-objs-y$(DEP_HTTP) += $(PATH_LIBQB)/src/http-stub.o
@ -22,11 +29,11 @@ libqb-objs-y$(DEP_CONSOLE_ONLY) += $(PATH_LIBQB)/src/mac-key-monitor.o
endif
$(PATH_LIBQB)/src/%.o: $(PATH_LIBQB)/src/%.cpp
$(CXX) -O2 $(CXXFLAGS) -Wall $< -c -o $@
$(CXX) -O2 $(CXXFLAGS) -Wall -Wextra $< -c -o $@
ifeq ($(OS),osx)
$(PATH_LIBQB)/src/%.o: $(PATH_LIBQB)/src/%.mm
$(CXX) -O2 $(CXXFLAGS) -Wall $< -c -o $@
$(CXX) -O2 $(CXXFLAGS) -Wall -Wextra $< -c -o $@
endif
CLEAN_LIST += $(libqb-objs-y) $(libqb-objs-yy) $(libqb-objs-)

6
internal/c/libqb/include/cmem.h Normal file
View file

@ -0,0 +1,6 @@
#pragma once
#include <stdint.h>
extern uint8_t cmem[1114099]; // 16*65535+65535+3 (enough for highest referencable dword in conv memory)
extern intptr_t dblock; // Required for Play(). Did not find this declared anywhere

12
internal/c/libqb/include/command.h Normal file
View file

@ -0,0 +1,12 @@
#pragma once
#include <stdint.h>
#include "qbs.h"
extern qbs *func_command_str;
qbs *func_command(int32_t index, int32_t passed);
int32_t func__commandcount();
void command_initialize(int argc, char **argv);

134
internal/c/libqb/include/error_handle.h Normal file
View file

@ -0,0 +1,134 @@
#ifndef INCLUDE_LIBQB_ERROR_HANDLE_H
#define INCLUDE_LIBQB_ERROR_HANDLE_H
#include <stdint.h>
#include "qbs.h"
void error(int32_t error_number);
void fix_error();
// FIXME: Should be removed in the future, use `is_error_pending()`.
//
// Some spots edit this directly to clear/restore an error, those sites should
// be examined for the best solution.
extern uint32_t new_error;
extern uint32_t error_err;
extern uint32_t error_occurred;
extern uint32_t error_goto_line;
extern uint32_t error_handling;
extern uint32_t error_retry;
static inline bool is_error_pending()
{
return new_error != 0;
}
void clear_error();
double get_error_erl();
uint32_t get_error_err();
int32_t func__errorline();
int32_t func__inclerrorline();
qbs *func__inclerrorfile();
qbs *func__errormessage(int32_t errorcode, int32_t passed);
void error_set_line(uint32_t errorline, uint32_t incerrorline, const char *incfilename);
#define QB_ERROR_NEXT_WITHOUT_FOR 1
#define QB_ERROR_SYNTAX_ERROR 2
#define QB_ERROR_RETURN_WITHOUT_GOSUB 3
#define QB_ERROR_OUT_OF_DATA 4
#define QB_ERROR_ILLEGAL_FUNCTION_CALL 5
#define QB_ERROR_OVERFLOW 6
#define QB_ERROR_OUT_OF_MEMORY 7
#define QB_ERROR_LABEL_NOT_DEFINED 8
#define QB_ERROR_SUBSCRIPT_OUT_OF_RANGE 9
#define QB_ERROR_DUPLICATE_DEFINITION 10
#define QB_ERROR_DIVISION_BY_ZERO 11
#define QB_ERROR_ILLEGAL_IN_DIRECT_MODE 12
#define QB_ERROR_TYPE_MISMATCH 13
#define QB_ERROR_OUT_OF_STRING_SPACE 14
#define QB_ERROR_STRING_FORMULA_TOO_COMPLEX 16
#define QB_ERROR_CANNOT_CONTINUE 17
#define QB_ERROR_FUNCTION_NOT_DEFINED 18
#define QB_ERROR_NO_RESUME 19
#define QB_ERROR_RESUME_WITHOUT_ERROR 20
#define QB_ERROR_DEVICE_TIMEOUT 24
#define QB_ERROR_DEVICE_FAULT 25
#define QB_ERROR_FOR_WITHOUT_NEXT 26
#define QB_ERROR_OUT_OF_PAPER 27
#define QB_ERROR_WHILE_WITHOUT_WEND 29
#define QB_ERROR_WEND_WITHOUT_WHILE 30
#define QB_ERROR_DUPLICATE_LABEL 33
#define QB_ERROR_SUBPROGRAM_NOT_DEFINED 35
#define QB_ERROR_ARGUMENT_COUNT_MISMATCH 37
#define QB_ERROR_ARRAY_NOT_DEFINED 38
#define QB_ERROR_VARIABLE_REQUIRED 40
#define QB_ERROR_FIELD_OVERFLOW 50
#define QB_ERROR_INTERNAL_ERROR 51
#define QB_ERROR_BAD_FILE_NAME_OR_NUMBER 52
#define QB_ERROR_FILE_NOT_FOUND 53
#define QB_ERROR_BAD_FILE_MODE 54
#define QB_ERROR_FILE_ALREADY_OPEN 55
#define QB_ERROR_FIELD_STATEMENT_ACTIVE 56
#define QB_ERROR_DEVICE_IO_ERROR 57
#define QB_ERROR_FILE_ALREADY_EXISTS 58
#define QB_ERROR_BAD_RECORD_LENGTH 59
#define QB_ERROR_DISK_FULL 61
#define QB_ERROR_INPUT_PAST_END_OF_FILE 62
#define QB_ERROR_BAD_RECORD_NUMBER 63
#define QB_ERROR_BAD_FILE_NAME 64
#define QB_ERROR_TOO_MANY_FILES 67
#define QB_ERROR_DEVICE_UNAVAILABLE 68
#define QB_ERROR_COMMUNICATION_BUFFER_OVERFLOW 69
#define QB_ERROR_PERMISSION_DENIED 70
#define QB_ERROR_DISK_NOT_READY 71
#define QB_ERROR_DISK_MEDIA_ERROR 72
#define QB_ERROR_FEATURE_UNAVAILABLE 73
#define QB_ERROR_RENAME_ACROSS_DISKS 74
#define QB_ERROR_PATH_FILE_ACCESS_ERROR 75
#define QB_ERROR_PATH_NOT_FOUND 76
#define QB_ERROR_OUT_OF_STACK_SPACE 256
#define QB_ERROR_OUT_OF_MEMORY_FATAL 257
#define QB_ERROR_INVALID_HANDLE 258
#define QB_ERROR_CANNOT_FIND_DYNAMIC_LIBRARY_FILE 259
#define QB_ERROR_FUNCTION_NOT_FOUND_IN_DYNAMIC_LIBRARY 260
#define QB_ERROR_FUNCTION_NOT_FOUND_IN_DYNAMIC_LIBRARY_261 261
#define QB_ERROR_GL_COMMAND_OUTSIDE_SUB_GL_SCOPE 270
#define QB_ERROR_END_SYSTEM_IN_SUB_GL_SCOPE 271
#define QB_ERROR_MEMORY_REGION_OUT_OF_RANGE 300
#define QB_ERROR_INVALID_SIZE 301
#define QB_ERROR_SOURCE_MEMORY_REGION_OUT_OF_RANGE 302
#define QB_ERROR_DESTINATION_MEMORY_REGION_OUT_OF_RANGE 303
#define QB_ERROR_BOTH_MEMORY_REGIONS_OUT_OF_RANGE 304
#define QB_ERROR_SOURCE_MEMORY_FREED 305
#define QB_ERROR_DESTINATION_MEMORY_FREED 306
#define QB_ERROR_MEMORY_ALREADY_FREED 307
#define QB_ERROR_MEMORY_HAS_BEEN_FREED 308
#define QB_ERROR_MEMORY_NOT_INITIALIZED 309
#define QB_ERROR_SOURCE_MEMORY_NOT_INITIALIZED 310
#define QB_ERROR_DESTINATION_MEMORY_NOT_INITIALIZED 311
#define QB_ERROR_BOTH_MEMORY_NOT_INITIALIZED 312
#define QB_ERROR_BOTH_MEMORY_FREED 313
#define QB_ERROR_ASSERT_FAILED 314
#define QB_ERROR_ASSERT_FAILED_WITH_DESCRIPTION 315
#define QB_ERROR_OUT_OF_MEMORY_FATAL_502 502
#define QB_ERROR_OUT_OF_MEMORY_FATAL_503 503
#define QB_ERROR_OUT_OF_MEMORY_FATAL_504 504
#define QB_ERROR_OUT_OF_MEMORY_FATAL_505 505
#define QB_ERROR_OUT_OF_MEMORY_FATAL_506 506
#define QB_ERROR_OUT_OF_MEMORY_FATAL_507 507
#define QB_ERROR_OUT_OF_MEMORY_FATAL_508 508
#define QB_ERROR_OUT_OF_MEMORY_FATAL_509 509
#define QB_ERROR_OUT_OF_MEMORY_FATAL_510 510
#define QB_ERROR_OUT_OF_MEMORY_FATAL_511 511
#define QB_ERROR_OUT_OF_MEMORY_FATAL_512 512
#define QB_ERROR_OUT_OF_MEMORY_FATAL_513 513
#define QB_ERROR_OUT_OF_MEMORY_FATAL_514 514
#define QB_ERROR_OUT_OF_MEMORY_FATAL_515 515
#define QB_ERROR_OUT_OF_MEMORY_FATAL_516 516
#define QB_ERROR_OUT_OF_MEMORY_FATAL_517 517
#define QB_ERROR_OUT_OF_MEMORY_FATAL_518 518
#endif

3
internal/c/libqb/include/libqb-common.h
View file

@ -55,4 +55,7 @@
# endif
#endif
#define QB_FALSE 0
#define QB_TRUE -1
#endif

74
internal/c/libqb/include/mem.h Normal file
View file

@ -0,0 +1,74 @@
#pragma once
#include <stdint.h>
struct mem_block {
intptr_t offset;
intptr_t size;
int64_t lock_id; // 64-bit key, must be present at lock's offset or memory region is invalid
intptr_t lock_offset; // pointer to lock
intptr_t type; // https://qb64phoenix.com/qb64wiki/index.php/MEM
intptr_t elementsize;
int32_t image;
int32_t sound;
};
#define INVALID_MEM_LOCK 1073741821
#define MEM_TYPE_NOSECURITY 0
#define MEM_TYPE_MALLOC 1
#define MEM_TYPE_IMAGE 2
#define MEM_TYPE_SUBFUNC 3
#define MEM_TYPE_ARRAY 4
#define MEM_TYPE_SOUND 5
struct mem_lock {
int64_t id;
int32_t type; // required to know what action to take (if any) when a request is made to free the block
// 0=no security (eg. user defined block from _OFFSET)
// 1=C-malloc'ed block
// 2=image
// 3=sub/function scope block
// 4=array
// 5=sound
//---- type specific variables follow ----
void *offset; // used by malloc'ed blocks to free them
};
extern uint64_t mem_lock_id;
extern mem_lock *mem_lock_tmp;
extern mem_lock *mem_lock_base;
int32_t func__memexists(void *blk);
void sub__memfill(mem_block *dblk, intptr_t doff, intptr_t dbytes, intptr_t soff, intptr_t sbytes);
void sub__memfill_nochecks(intptr_t doff, intptr_t dbytes, intptr_t soff, intptr_t sbytes);
void sub__memfill_1(mem_block *dblk, intptr_t doff, intptr_t dbytes, int8_t val);
void sub__memfill_nochecks_1(intptr_t doff, intptr_t dbytes, int8_t val);
void sub__memfill_2(mem_block *dblk, intptr_t doff, intptr_t dbytes, int16_t val);
void sub__memfill_nochecks_2(intptr_t doff, intptr_t dbytes, int16_t val);
void sub__memfill_4(mem_block *dblk, intptr_t doff, intptr_t dbytes, int32_t val);
void sub__memfill_nochecks_4(intptr_t doff, intptr_t dbytes, int32_t val);
void sub__memfill_8(mem_block *dblk, intptr_t doff, intptr_t dbytes, int64_t val);
void sub__memfill_nochecks_8(intptr_t doff, intptr_t dbytes, int64_t val);
void sub__memfill_SINGLE(mem_block *dblk, intptr_t doff, intptr_t dbytes, float val);
void sub__memfill_nochecks_SINGLE(intptr_t doff, intptr_t dbytes, float val);
void sub__memfill_DOUBLE(mem_block *dblk, intptr_t doff, intptr_t dbytes, double val);
void sub__memfill_nochecks_DOUBLE(intptr_t doff, intptr_t dbytes, double val);
void sub__memfill_FLOAT(mem_block *dblk, intptr_t doff, intptr_t dbytes, long double val);
void sub__memfill_nochecks_FLOAT(intptr_t doff, intptr_t dbytes, long double val);
void sub__memfill_OFFSET(mem_block *dblk, intptr_t doff, intptr_t dbytes, intptr_t val);
void sub__memfill_nochecks_OFFSET(intptr_t doff, intptr_t dbytes, intptr_t val);
void *func__memget(mem_block *blk, intptr_t off, intptr_t bytes);
void new_mem_lock();
void free_mem_lock(mem_lock *lock);
mem_block func__mem(intptr_t offset, intptr_t size, int32_t type, intptr_t elementsize, mem_lock *lock);
mem_block func__mem_at_offset(intptr_t offset, intptr_t size);
mem_block func__memnew(intptr_t);
void sub__memfree(void *);
void sub__memcopy(void *sblk, intptr_t soff, intptr_t bytes, void *dblk, intptr_t doff);

110
internal/c/libqb/include/qbs.h Normal file
View file

@ -0,0 +1,110 @@
#ifndef INCLUDE_LIBQB_QBS_H
#define INCLUDE_LIBQB_QBS_H
#include <stdint.h>
// QB64 string descriptor structure
struct qbs_field {
int32_t fileno;
int64_t fileid;
int64_t size;
int64_t offset;
};
struct qbs {
uint8_t *chr; // a 32 bit pointer to the string's data
int32_t len; // must be signed for comparisons against signed int32s
uint8_t in_cmem; // set to 1 if in the conventional memory DBLOCK
uint16_t *cmem_descriptor;
uint16_t cmem_descriptor_offset;
uint32_t listi; // the index in the list of strings that references it
uint8_t tmp; // set to 1 if the string can be deleted immediately after being processed
uint32_t tmplisti; // the index in the list of strings that references it
uint8_t fixed; // fixed length string
uint8_t readonly; // set to 1 if string is read only
//
qbs_field *field;
};
qbs *qbs_new(int32_t, uint8_t);
qbs *qbs_new_txt(const char *);
qbs *qbs_new_cmem(int32_t size, uint8_t tmp);
qbs *qbs_new_txt_len(const char *txt, int32_t len);
qbs *qbs_new_fixed(uint8_t *offset, uint32_t size, uint8_t tmp);
qbs *qbs_add(qbs *, qbs *);
qbs *qbs_set(qbs *, qbs *);
// Called by vWatch
void set_qbs_size(intptr_t *target_qbs, int32_t newlength);
void qbs_free(qbs *str);
qbs *qbs_str(int64_t value);
qbs *qbs_str(int32_t value);
qbs *qbs_str(int16_t value);
qbs *qbs_str(int8_t value);
qbs *qbs_str(uint64_t value);
qbs *qbs_str(uint32_t value);
qbs *qbs_str(uint16_t value);
qbs *qbs_str(uint8_t value);
qbs *qbs_str(float value);
qbs *qbs_str(double value);
qbs *qbs_str(long double value);
qbs *func_chr(int32_t value);
qbs *qbs_ucase(qbs *str);
qbs *qbs_lcase(qbs *str);
qbs *qbs_left(qbs *str, int32_t l);
qbs *qbs_right(qbs *str, int32_t l);
int32_t qbs_equal(qbs *str1, qbs *str2);
int32_t qbs_notequal(qbs *str1, qbs *str2);
int32_t qbs_greaterthan(qbs *str2, qbs *str1);
int32_t qbs_lessthan(qbs *str1, qbs *str2);
int32_t qbs_lessorequal(qbs *str1, qbs *str2);
int32_t qbs_greaterorequal(qbs *str2, qbs *str1);
int32_t qbs_asc(qbs *str, uint32_t i);
int32_t qbs_asc(qbs *str);
int32_t qbs_len(qbs *str);
// FIXME: Usages of these outside of qbx.c (and qbs_cleanup()) need to be removed.
extern intptr_t *qbs_tmp_list;
extern uint32_t qbs_tmp_list_lasti;
extern uint32_t qbs_tmp_list_nexti;
template <typename T> static T qbs_cleanup(uint32_t base, T passvalue) {
while (qbs_tmp_list_nexti > base) {
qbs_tmp_list_nexti--;
if (qbs_tmp_list[qbs_tmp_list_nexti] != -1)
qbs_free((qbs *)qbs_tmp_list[qbs_tmp_list_nexti]);
} // clear any temp. strings created
return passvalue;
}
void sub_lset(qbs *dest, qbs *source);
void sub_rset(qbs *dest, qbs *source);
qbs *func_space(int32_t spaces);
qbs *func_string(int32_t characters, int32_t asciivalue);
int32_t func_instr(int32_t start, qbs *str, qbs *substr, int32_t passed);
int32_t func__instrrev(int32_t start, qbs *str, qbs *substr, int32_t passed);
void sub_mid(qbs *dest, int32_t start, int32_t l, qbs *src, int32_t passed);
qbs *func_mid(qbs *str, int32_t start, int32_t l, int32_t passed);
qbs *qbs_ltrim(qbs *str);
qbs *qbs_rtrim(qbs *str);
qbs *qbs__trim(qbs *str);
int32_t func__str_nc_compare(qbs *s1, qbs *s2);
int32_t func__str_compare(qbs *s1, qbs *s2);
// FIXME: Maybe put this in a gfs related header?
void lrset_field(qbs *str);
void field_free(qbs *str);
#endif

64
internal/c/libqb/src/command.cpp Normal file
View file

@ -0,0 +1,64 @@
#include "libqb-common.h"
#include <stdlib.h>
#include <string.h>
#include "command.h"
qbs *func_command_str = NULL;
static char **func_command_array = NULL;
static int32_t func_command_count = 0;
qbs *func_command(int32_t index, int32_t passed) {
static qbs *tqbs;
if (passed) { // Get specific parameter
// If out of bounds or error getting cmdline args, return empty string.
if (index >= func_command_count || index < 0 || func_command_array == NULL) {
tqbs = qbs_new(0, 1);
return tqbs;
}
int len = strlen(func_command_array[index]);
// Create new temp qbs and copy data into it.
tqbs = qbs_new(len, 1);
memcpy(tqbs->chr, func_command_array[index], len);
} else { // Legacy support; return whole commandline
tqbs = qbs_new(func_command_str->len, 1);
memcpy(tqbs->chr, func_command_str->chr, func_command_str->len);
}
return tqbs;
}
int32_t func__commandcount() {
return func_command_count - 1;
}
void command_initialize(int argc, char **argv) {
int i = argc;
if (i > 1) {
// calculate required size of COMMAND$ string
int i2 = 0;
for (i = 1; i < argc; i++) {
i2 += strlen(argv[i]);
if (i != 1)
i2++; // for a space
}
// create COMMAND$ string
func_command_str = qbs_new(i2, 0);
// build COMMAND$ string
int i3 = 0;
for (i = 1; i < argc; i++) {
if (i != 1) {
func_command_str->chr[i3] = 32;
i3++;
}
memcpy(&func_command_str->chr[i3], argv[i], strlen(argv[i]));
i3 += strlen(argv[i]);
}
} else {
func_command_str = qbs_new(0, 0);
}
func_command_count = argc;
func_command_array = argv;
}

345
internal/c/libqb/src/error_handle.cpp Normal file
View file

@ -0,0 +1,345 @@
#include "libqb-common.h"
#include <stdlib.h>
#include <string.h>
#include <stdint.h>
#include <stdio.h>
#include "command.h"
#include "event.h"
#include "gui.h"
#include "error_handle.h"
uint32_t new_error;
uint32_t error_occurred;
uint32_t error_retry;
uint32_t error_err; //=0;
uint32_t error_goto_line;
uint32_t error_handling;
static double error_erl; //=0;
static uint32_t ercl;
static uint32_t inclercl;
static const char *includedfilename;
static char *human_error(int32_t errorcode) {
// clang-format off
switch (errorcode) {
case 0: return "No error";
case 1: return "NEXT without FOR";
case 2: return "Syntax error";
case 3: return "RETURN without GOSUB";
case 4: return "Out of DATA";
case 5: return "Illegal function call";
case 6: return "Overflow";
case 7: return "Out of memory";
case 8: return "Label not defined";
case 9: return "Subscript out of range";
case 10: return "Duplicate definition";
case 12: return "Illegal in direct mode";
case 13: return "Type mismatch";
case 14: return "Out of string space";
//error 15 undefined
case 16: return "String formula too complex";
case 17: return "Cannot continue";
case 18: return "Function not defined";
case 19: return "No RESUME";
case 20: return "RESUME without error";
//error 21-23 undefined
case 24: return "Device timeout";
case 25: return "Device fault";
case 26: return "FOR without NEXT";
case 27: return "Out of paper";
//error 28 undefined
case 29: return "WHILE without WEND";
case 30: return "WEND without WHILE";
//error 31-32 undefined
case 33: return "Duplicate label";
//error 34 undefined
case 35: return "Subprogram not defined";
//error 36 undefined
case 37: return "Argument-count mismatch";
case 38: return "Array not defined";
case 40: return "Variable required";
case 50: return "FIELD overflow";
case 51: return "Internal error";
case 52: return "Bad file name or number";
case 53: return "File not found";
case 54: return "Bad file mode";
case 55: return "File already open";
case 56: return "FIELD statement active";
case 57: return "Device I/O error";
case 58: return "File already exists";
case 59: return "Bad record length";
case 61: return "Disk full";
case 62: return "Input past end of file";
case 63: return "Bad record number";
case 64: return "Bad file name";
case 67: return "Too many files";
case 68: return "Device unavailable";
case 69: return "Communication-buffer overflow";
case 70: return "Permission denied";
case 71: return "Disk not ready";
case 72: return "Disk-media error";
case 73: return "Feature unavailable";
case 74: return "Rename across disks";
case 75: return "Path/File access error";
case 76: return "Path not found";
case 258: return "Invalid handle";
case 300: return "Memory region out of range";
case 301: return "Invalid size";
case 302: return "Source memory region out of range";
case 303: return "Destination memory region out of range";
case 304: return "Source and destination memory regions out of range";
case 305: return "Source memory has been freed";
case 306: return "Destination memory has been freed";
case 307: return "Memory already freed";
case 308: return "Memory has been freed";
case 309: return "Memory not initialized";
case 310: return "Source memory not initialized";
case 311: return "Destination memory not initialized";
case 312: return "Source and destination memory not initialized";
case 313: return "Source and destination memory have been freed";
case 314: return "_ASSERT failed";
case 315: return "_ASSERT failed (check console for description)";
default: return "Unprintable error";
}
// clang-format on
}
void clear_error()
{
new_error = 0;
}
double get_error_erl()
{
return error_erl;
}
uint32_t get_error_err()
{
return error_err;
}
int32_t func__errorline()
{
return ercl;
}
int32_t func__inclerrorline()
{
return inclercl;
}
qbs *func__inclerrorfile()
{
return qbs_new_txt(includedfilename);
}
void error_set_line(uint32_t errorline, uint32_t incerrorline, const char *incfilename)
{
ercl = errorline;
inclercl = incerrorline;
includedfilename = incfilename;
}
qbs *func__errormessage(int32_t errorcode, int32_t passed) {
if (!passed)
errorcode = get_error_err();
return qbs_new_txt(human_error(errorcode));
}
extern uint8_t close_program;
extern double last_line;
void end();
extern void QBMAIN(void *);
void fix_error() {
char *errtitle = NULL, *errmess = NULL, *cp;
int prevent_handling = 0, len, v;
if ((new_error >= 300) && (new_error <= 315))
prevent_handling = 1;
if (!error_goto_line || error_handling || prevent_handling) {
// strip path from binary name
static int32_t i;
static qbs *binary_name = NULL;
if (!binary_name)
binary_name = qbs_new(0, 0);
qbs_set(binary_name, qbs_add(func_command(0, 1), qbs_new_txt_len("\0", 1)));
for (i = binary_name->len; i > 0; i--) {
if ((binary_name->chr[i - 1] == 47) || (binary_name->chr[i - 1] == 92)) {
qbs_set(binary_name, func_mid(binary_name, i + 1, NULL, 0));
break;
}
}
cp = human_error(new_error);
#define FIXERRMSG_TITLE "%s%u - %s"
#define FIXERRMSG_BODY "Line: %u (in %s)\n%s%s"
#define FIXERRMSG_MAINFILE "main module"
#define FIXERRMSG_CONT "\nContinue?"
#define FIXERRMSG_UNHAND "Unhandled Error #"
#define FIXERRMSG_CRIT "Critical Error #"
len = snprintf(errmess, 0, FIXERRMSG_BODY, (inclercl ? inclercl : ercl), (inclercl ? includedfilename : FIXERRMSG_MAINFILE), cp,
(!prevent_handling ? FIXERRMSG_CONT : ""));
errmess = (char *)malloc(len + 1);
if (!errmess)
exit(0); // At this point we just give up
snprintf(errmess, len + 1, FIXERRMSG_BODY, (inclercl ? inclercl : ercl), (inclercl ? includedfilename : FIXERRMSG_MAINFILE), cp,
(!prevent_handling ? FIXERRMSG_CONT : ""));
len = snprintf(errtitle, 0, FIXERRMSG_TITLE, (!prevent_handling ? FIXERRMSG_UNHAND : FIXERRMSG_CRIT), new_error, binary_name->chr);
errtitle = (char *)malloc(len + 1);
if (!errtitle)
exit(0); // At this point we just give up
snprintf(errtitle, len + 1, FIXERRMSG_TITLE, (!prevent_handling ? FIXERRMSG_UNHAND : FIXERRMSG_CRIT), new_error, binary_name->chr);
if (prevent_handling) {
v = gui_alert(errmess, errtitle, "ok");
exit(0);
} else {
v = gui_alert(errmess, errtitle, "yesno");
}
if ((v == 2) || (v == 0)) {
close_program = 1;
end();
}
new_error = 0;
return;
}
error_err = new_error;
new_error = 0;
error_erl = last_line;
error_occurred = 1;
// FIXME: EWWWWW, there's no way this is correct
QBMAIN(NULL);
return;
}
void error(int32_t error_number) {
// critical errors:
// out of memory errors
if (error_number == 257) {
gui_alert("Out of memory", "Critical Error #1", "ok");
exit(0);
} // generic "Out of memory" error
// tracable "Out of memory" errors
if (error_number == 502) {
gui_alert("Out of memory", "Critical Error #2", "ok");
exit(0);
}
if (error_number == 503) {
gui_alert("Out of memory", "Critical Error #3", "ok");
exit(0);
}
if (error_number == 504) {
gui_alert("Out of memory", "Critical Error #4", "ok");
exit(0);
}
if (error_number == 505) {
gui_alert("Out of memory", "Critical Error #5", "ok");
exit(0);
}
if (error_number == 506) {
gui_alert("Out of memory", "Critical Error #6", "ok");
exit(0);
}
if (error_number == 507) {
gui_alert("Out of memory", "Critical Error #7", "ok");
exit(0);
}
if (error_number == 508) {
gui_alert("Out of memory", "Critical Error #8", "ok");
exit(0);
}
if (error_number == 509) {
gui_alert("Out of memory", "Critical Error #9", "ok");
exit(0);
}
if (error_number == 510) {
gui_alert("Out of memory", "Critical Error #10", "ok");
exit(0);
}
if (error_number == 511) {
gui_alert("Out of memory", "Critical Error #11", "ok");
exit(0);
}
if (error_number == 512) {
gui_alert("Out of memory", "Critical Error #12", "ok");
exit(0);
}
if (error_number == 513) {
gui_alert("Out of memory", "Critical Error #13", "ok");
exit(0);
}
if (error_number == 514) {
gui_alert("Out of memory", "Critical Error #14", "ok");
exit(0);
}
if (error_number == 515) {
gui_alert("Out of memory", "Critical Error #15", "ok");
exit(0);
}
if (error_number == 516) {
gui_alert("Out of memory", "Critical Error #16", "ok");
exit(0);
}
if (error_number == 517) {
gui_alert("Out of memory", "Critical Error #17", "ok");
exit(0);
}
if (error_number == 518) {
gui_alert("Out of memory", "Critical Error #18", "ok");
exit(0);
}
// other critical errors
if (error_number == 11) {
gui_alert("Division by zero", "Critical Error", "ok");
exit(0);
}
if (error_number == 256) {
gui_alert("Out of stack space", "Critical Error", "ok");
exit(0);
}
if (error_number == 259) {
gui_alert("Cannot find dynamic library file", "Critical Error", "ok");
exit(0);
}
if (error_number == 260) {
gui_alert("Sub/Function does not exist in dynamic library", "Critical Error", "ok");
exit(0);
}
if (error_number == 261) {
gui_alert("Sub/Function does not exist in dynamic library", "Critical Error", "ok");
exit(0);
}
if (error_number == 270) {
gui_alert("_GL command called outside of SUB _GL's scope", "Critical Error", "ok");
exit(0);
}
if (error_number == 271) {
gui_alert("END/SYSTEM called within SUB _GL's scope", "Critical Error", "ok");
exit(0);
}
if (!new_error) {
if ((new_error == 256) || (new_error == 257))
fix_error(); // critical error!
if (error_number <= 0)
error_number = 5; // Illegal function call
new_error = error_number;
qbevent = 1;
}
}

292
internal/c/libqb/src/mem.cpp Normal file
View file

@ -0,0 +1,292 @@
#include "libqb-common.h"
#include <stdlib.h>
#include <string.h>
#include "error_handle.h"
#include "mem.h"
// QB64 memory blocks
uint64_t mem_lock_id = 1073741823; // this value should never be 0 or 1
int32_t mem_lock_max = 10000;
int32_t mem_lock_next = 0;
mem_lock *mem_lock_base = (mem_lock *)malloc(sizeof(mem_lock) * mem_lock_max);
mem_lock *mem_lock_tmp;
int32_t mem_lock_freed_max = 1000; // number of allocated entries
int32_t mem_lock_freed_n = 0; // number of entries
intptr_t *mem_lock_freed = (intptr_t *)malloc(sizeof(intptr_t) * mem_lock_freed_max);
void new_mem_lock() {
if (mem_lock_freed_n) {
mem_lock_tmp = (mem_lock *)mem_lock_freed[--mem_lock_freed_n];
} else {
if (mem_lock_next == mem_lock_max) {
mem_lock_base = (mem_lock *)malloc(sizeof(mem_lock) * mem_lock_max);
mem_lock_next = 0;
}
mem_lock_tmp = &mem_lock_base[mem_lock_next++];
}
mem_lock_tmp->id = ++mem_lock_id;
}
void free_mem_lock(mem_lock *lock) {
lock->id = 0; // invalidate lock
if (lock->type == 1)
free(lock->offset); // malloc type
// add to freed list
if (mem_lock_freed_n == mem_lock_freed_max) {
mem_lock_freed_max *= 2;
mem_lock_freed = (intptr_t *)realloc(mem_lock_freed, sizeof(intptr_t) * mem_lock_freed_max);
}
mem_lock_freed[mem_lock_freed_n++] = (intptr_t)lock;
}
void sub__memfree(void *mem) {
// 1:malloc: memory will be freed if it still exists
// 2:images: will not be freed, no action will be taken
// exists?
if (((mem_block *)(mem))->lock_offset == NULL) {
error(309);
return;
}
if (((mem_lock *)(((mem_block *)(mem))->lock_offset))->id != ((mem_block *)(mem))->lock_id) {
error(307);
return;
} // memory has been freed
if (((mem_lock *)(((mem_block *)(mem))->lock_offset))->type == 0) { // no security
free_mem_lock((mem_lock *)((mem_block *)(mem))->lock_offset);
}
if (((mem_lock *)(((mem_block *)(mem))->lock_offset))->type == 1) { // malloc
free_mem_lock((mem_lock *)((mem_block *)(mem))->lock_offset);
}
// note: type 2(image) is freed when the image is freed
// invalidate caller's mem structure (avoids misconception that _MEMFREE failed)
((mem_block *)(mem))->lock_id = 1073741821;
}
extern mem_block func__mem_at_offset(intptr_t offset, intptr_t size) {
static mem_block b;
new_mem_lock();
mem_lock_tmp->type = 0; // unsecured
b.lock_offset = (intptr_t)mem_lock_tmp;
b.lock_id = mem_lock_id;
b.offset = offset;
b.size = size;
b.type = 16384; //_MEMNEW type
b.elementsize = 1;
b.image = -1;
if ((size < 0) || is_error_pending()) {
b.type = 0;
b.size = 0;
b.offset = 0;
if (size < 0)
error(301);
}
return b;
}
mem_block func__memnew(intptr_t bytes) {
static mem_block b;
new_mem_lock();
b.lock_offset = (intptr_t)mem_lock_tmp;
b.lock_id = mem_lock_id;
b.type = 16384; //_MEMNEW type
b.elementsize = 1;
b.image = -1;
if (is_error_pending()) {
b.type = 0;
b.offset = 0;
b.size = 0;
mem_lock_tmp->type = 0;
return b;
}
if (bytes < 0) {
// still create a block, but an invalid one and generate an error
error(5);
b.offset = 0;
b.size = 0;
mem_lock_tmp->type = 0;
} else {
if (!bytes) {
b.offset = 1; // non-zero=success
b.size = 0;
} else {
b.offset = (intptr_t)malloc(bytes);
if (!b.offset) {
b.size = 0;
mem_lock_tmp->type = 0;
} else {
b.size = bytes;
mem_lock_tmp->type = 1;
mem_lock_tmp->offset = (void *)b.offset;
}
}
}
return b;
}
int32_t func__memexists(void *void_blk) {
static mem_block *blk;
blk = (mem_block *)void_blk;
if (((mem_block *)(blk))->lock_offset == NULL)
return 0;
if (((mem_lock *)(((mem_block *)(blk))->lock_offset))->id == ((mem_block *)(blk))->lock_id)
return -1;
return 0;
}
void *func__memget(mem_block *blk, intptr_t off, intptr_t bytes) {
// checking A
if (((mem_block *)(blk))->lock_offset == NULL) {
error(309);
goto fail;
}
// checking B
if (off < ((mem_block *)(blk))->offset || (off + bytes) > (((mem_block *)(blk))->offset + ((mem_block *)(blk))->size) ||
((mem_lock *)(((mem_block *)(blk))->lock_offset))->id != ((mem_block *)(blk))->lock_id) {
// error reporting
if (((mem_lock *)(((mem_block *)(blk))->lock_offset))->id != ((mem_block *)(blk))->lock_id) {
error(308);
goto fail;
}
error(300);
goto fail;
}
return (void *)off;
//------------------------------------------------------------
fail:
static void *fail_buffer;
fail_buffer = calloc(bytes, 1);
if (!fail_buffer)
error(518); // critical error: out of memory
return fail_buffer;
}
void sub__memfill_nochecks(intptr_t doff, intptr_t dbytes, intptr_t soff, intptr_t sbytes) {
if (sbytes == 1) {
memset((void *)doff, *(uint8_t *)soff, dbytes);
return;
}
static intptr_t si;
si = 0;
while (dbytes--) {
*(int8_t *)(doff++) = *(int8_t *)(soff + si++);
if (si >= sbytes)
si = 0;
}
}
void sub__memfill(mem_block *dblk, intptr_t doff, intptr_t dbytes, intptr_t soff, intptr_t sbytes) {
if (((mem_block *)(dblk))->lock_offset == NULL) {
error(309);
return;
}
if (((mem_lock *)(((mem_block *)(dblk))->lock_offset))->id != ((mem_block *)(dblk))->lock_id) {
error(308);
return;
}
if ((dbytes < 0) || (sbytes == 0)) {
error(301);
return;
}
if (doff < ((mem_block *)(dblk))->offset || (doff + dbytes) > (((mem_block *)(dblk))->offset + ((mem_block *)(dblk))->size)) {
error(300);
return;
}
sub__memfill_nochecks(doff, dbytes, soff, sbytes);
}
void sub__memfill_1(mem_block *dblk, intptr_t doff, intptr_t dbytes, int8_t val) { sub__memfill(dblk, doff, dbytes, (intptr_t)&val, 1); }
void sub__memfill_nochecks_1(intptr_t doff, intptr_t dbytes, int8_t val) { sub__memfill_nochecks(doff, dbytes, (intptr_t)&val, 1); }
void sub__memfill_2(mem_block *dblk, intptr_t doff, intptr_t dbytes, int16_t val) { sub__memfill(dblk, doff, dbytes, (intptr_t)&val, 2); }
void sub__memfill_nochecks_2(intptr_t doff, intptr_t dbytes, int16_t val) { sub__memfill_nochecks(doff, dbytes, (intptr_t)&val, 2); }
void sub__memfill_4(mem_block *dblk, intptr_t doff, intptr_t dbytes, int32_t val) { sub__memfill(dblk, doff, dbytes, (intptr_t)&val, 4); }
void sub__memfill_nochecks_4(intptr_t doff, intptr_t dbytes, int32_t val) { sub__memfill_nochecks(doff, dbytes, (intptr_t)&val, 4); }
void sub__memfill_8(mem_block *dblk, intptr_t doff, intptr_t dbytes, int64_t val) { sub__memfill(dblk, doff, dbytes, (intptr_t)&val, 8); }
void sub__memfill_nochecks_8(intptr_t doff, intptr_t dbytes, int64_t val) { sub__memfill_nochecks(doff, dbytes, (intptr_t)&val, 8); }
void sub__memfill_SINGLE(mem_block *dblk, intptr_t doff, intptr_t dbytes, float val) { sub__memfill(dblk, doff, dbytes, (intptr_t)&val, 4); }
void sub__memfill_nochecks_SINGLE(intptr_t doff, intptr_t dbytes, float val) { sub__memfill_nochecks(doff, dbytes, (intptr_t)&val, 4); }
void sub__memfill_DOUBLE(mem_block *dblk, intptr_t doff, intptr_t dbytes, double val) { sub__memfill(dblk, doff, dbytes, (intptr_t)&val, 8); }
void sub__memfill_nochecks_DOUBLE(intptr_t doff, intptr_t dbytes, double val) { sub__memfill_nochecks(doff, dbytes, (intptr_t)&val, 8); }
static uint8_t memfill_FLOAT_padding[] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; // 32 null bytes
void sub__memfill_FLOAT(mem_block *dblk, intptr_t doff, intptr_t dbytes, long double val) {
*(long double *)memfill_FLOAT_padding = val;
sub__memfill(dblk, doff, dbytes, (intptr_t)memfill_FLOAT_padding, 32);
}
void sub__memfill_nochecks_FLOAT(intptr_t doff, intptr_t dbytes, long double val) {
*(long double *)memfill_FLOAT_padding = val;
sub__memfill_nochecks(doff, dbytes, (intptr_t)memfill_FLOAT_padding, 32);
}
void sub__memfill_OFFSET(mem_block *dblk, intptr_t doff, intptr_t dbytes, intptr_t val) { sub__memfill(dblk, doff, dbytes, (intptr_t)&val, sizeof(intptr_t)); }
void sub__memfill_nochecks_OFFSET(intptr_t doff, intptr_t dbytes, intptr_t val) { sub__memfill_nochecks(doff, dbytes, (intptr_t)&val, sizeof(intptr_t)); }
void sub__memcopy(void *sblk, intptr_t soff, intptr_t bytes, void *dblk, intptr_t doff) {
// checking A
if (((mem_block *)(sblk))->lock_offset == NULL || ((mem_block *)(dblk))->lock_offset == NULL) {
// error reporting
if (((mem_block *)(sblk))->lock_offset == NULL && ((mem_block *)(dblk))->lock_offset == NULL) {
error(312);
return;
}
if (((mem_block *)(sblk))->lock_offset == NULL) {
error(310);
return;
}
error(311);
return;
}
// checking B
if (bytes < 0 || soff < ((mem_block *)(sblk))->offset || (soff + bytes) > (((mem_block *)(sblk))->offset + ((mem_block *)(sblk))->size) ||
doff < ((mem_block *)(dblk))->offset || (doff + bytes) > (((mem_block *)(dblk))->offset + ((mem_block *)(dblk))->size) ||
((mem_lock *)(((mem_block *)(sblk))->lock_offset))->id != ((mem_block *)(sblk))->lock_id ||
((mem_lock *)(((mem_block *)(dblk))->lock_offset))->id != ((mem_block *)(dblk))->lock_id) {
// error reporting
if (((mem_lock *)(((mem_block *)(sblk))->lock_offset))->id != ((mem_block *)(sblk))->lock_id &&
((mem_lock *)(((mem_block *)(dblk))->lock_offset))->id != ((mem_block *)(dblk))->lock_id) {
error(313);
return;
}
if (((mem_lock *)(((mem_block *)(sblk))->lock_offset))->id != ((mem_block *)(sblk))->lock_id) {
error(305);
return;
}
if (((mem_lock *)(((mem_block *)(dblk))->lock_offset))->id != ((mem_block *)(dblk))->lock_id) {
error(306);
return;
}
if (bytes < 0) {
error(301);
return;
}
if (soff < ((mem_block *)(sblk))->offset || (soff + bytes) > (((mem_block *)(sblk))->offset + ((mem_block *)(sblk))->size)) {
if (doff < ((mem_block *)(dblk))->offset || (doff + bytes) > (((mem_block *)(dblk))->offset + ((mem_block *)(dblk))->size)) {
error(304);
return;
}
error(302);
return;
}
error(303);
return;
}
memmove((char *)doff, (char *)soff, bytes);
}
mem_block func__mem(intptr_t offset, intptr_t size, int32_t type, intptr_t elementsize, mem_lock *lock) {
static mem_block b;
b.lock_offset = (intptr_t)lock;
b.lock_id = lock->id;
b.offset = offset;
b.size = size;
b.type = type;
b.elementsize = elementsize;
b.image = -1;
return b;
}

671
internal/c/libqb/src/qbs.cpp Normal file
View file

@ -0,0 +1,671 @@
#include "libqb-common.h"
#include <stdlib.h>
#include <string.h>
#include "error_handle.h"
#include "qbs.h"
// FIXME: Put in internal header
void qbs_remove_cmem(qbs *str);
bool qbs_new_fixed_cmem(uint8_t *offset, uint32_t size, uint8_t tmp, qbs *newstr);
void qbs_move_cmem(qbs *deststr, qbs *srcstr);
void qbs_copy_cmem(qbs *deststr, qbs *srcstr);
void qbs_create_cmem(int32_t size, uint8_t tmp, qbs *newstr);
static qbs *qbs_malloc = (qbs *)calloc(sizeof(qbs) * 65536, 1); //~1MEG
static uint32_t qbs_malloc_next = 0; // the next idex in qbs_malloc to use
static intptr_t *qbs_malloc_freed = (intptr_t *)malloc(sizeof (*qbs_malloc_freed) * 65536);
static uint32_t qbs_malloc_freed_size = 65536;
static uint32_t qbs_malloc_freed_num = 0; // number of freed qbs descriptors
static qbs *qbs_new_descriptor() {
// MLP //qbshlp1++;
if (qbs_malloc_freed_num) {
/*MLP
static qbs *s;
s=(qbs*)memset((void *)qbs_malloc_freed[--qbs_malloc_freed_num],0,sizeof(qbs));
s->dbgl=dbgline;
return s;
*/
return (qbs *)memset((void *)qbs_malloc_freed[--qbs_malloc_freed_num], 0, sizeof(qbs));
}
if (qbs_malloc_next == 65536) {
qbs_malloc = (qbs *)calloc(sizeof(qbs) * 65536, 1); //~1MEG
qbs_malloc_next = 0;
}
/*MLP
dbglist[dbglisti]=(uint32)&qbs_malloc[qbs_malloc_next];
static qbs* s;
s=(qbs*)&qbs_malloc[qbs_malloc_next++];
s->dbgl=dbgline;
dbglisti++;
return s;
*/
return &qbs_malloc[qbs_malloc_next++];
}
static void qbs_free_descriptor(qbs *str) {
// MLP //qbshlp1--;
if (qbs_malloc_freed_num == qbs_malloc_freed_size) {
qbs_malloc_freed_size *= 2;
qbs_malloc_freed = (intptr_t *)realloc(qbs_malloc_freed, qbs_malloc_freed_size * sizeof (*qbs_malloc_freed));
if (!qbs_malloc_freed)
error(508);
}
qbs_malloc_freed[qbs_malloc_freed_num] = (intptr_t)str;
qbs_malloc_freed_num++;
return;
}
// Used to track strings in 32bit memory
static intptr_t *qbs_list = (intptr_t *)malloc(65536 * sizeof(intptr_t));
static uint32_t qbs_list_lasti = 65535;
static uint32_t qbs_list_nexti = 0;
// Used to track temporary strings for later removal when they fall out of scope
//*Some string functions delete a temporary string automatically after they have been
// passed one to save memory. In this case qbstring_templist[?]=0xFFFFFFFF
intptr_t *qbs_tmp_list = (intptr_t *)calloc(65536 * sizeof(intptr_t), 1); // first index MUST be 0
uint32_t qbs_tmp_list_lasti = 65535;
uint32_t qbs_tmp_list_nexti;
// entended string memory
static uint8_t *qbs_data = (uint8_t *)malloc(1048576);
static uint32_t qbs_data_size = 1048576;
static uint32_t qbs_sp = 0;
void qbs_free(qbs *str) {
if (str->field)
field_free(str);
if (str->tmplisti) {
qbs_tmp_list[str->tmplisti] = -1;
while (qbs_tmp_list[qbs_tmp_list_nexti - 1] == -1) {
qbs_tmp_list_nexti--;
}
}
if (str->fixed || str->readonly) {
qbs_free_descriptor(str);
return;
}
if (str->in_cmem) {
qbs_remove_cmem(str);
} else {
qbs_list[str->listi] = -1;
retry:
if (qbs_list[qbs_list_nexti - 1] == -1) {
qbs_list_nexti--;
if (qbs_list_nexti)
goto retry;
}
if (qbs_list_nexti) {
qbs_sp = ((qbs *)qbs_list[qbs_list_nexti - 1])->chr - qbs_data + ((qbs *)qbs_list[qbs_list_nexti - 1])->len + 32;
if (qbs_sp > qbs_data_size)
qbs_sp = qbs_data_size; // adding 32 could overflow buffer!
} else {
qbs_sp = 0;
}
}
qbs_free_descriptor(str);
return;
}
static void qbs_concat_list() {
uint32_t i;
uint32_t d;
qbs *tqbs;
d = 0;
for (i = 0; i < qbs_list_nexti; i++) {
if (qbs_list[i] != -1) {
if (i != d) {
tqbs = (qbs *)qbs_list[i];
tqbs->listi = d;
qbs_list[d] = (intptr_t)tqbs;
}
d++;
}
}
qbs_list_nexti = d;
// if string listings are taking up more than half of the list array double the list array's size
if (qbs_list_nexti >= (qbs_list_lasti / 2)) {
qbs_list_lasti *= 2;
qbs_list = (intptr_t *)realloc(qbs_list, (qbs_list_lasti + 1) * sizeof (*qbs_list));
if (!qbs_list)
error(510);
}
return;
}
static void qbs_tmp_concat_list() {
if (qbs_tmp_list_nexti >= (qbs_tmp_list_lasti / 2)) {
qbs_tmp_list_lasti *= 2;
qbs_tmp_list = (intptr_t *)realloc(qbs_tmp_list, (qbs_tmp_list_lasti + 1) * sizeof (*qbs_tmp_list));
if (!qbs_tmp_list)
error(511);
}
return;
}
static void qbs_concat(uint32_t bytesrequired) {
// this does not change indexing, only ->chr pointers and the location of their data
static int32_t i;
static uint8_t *dest;
static qbs *tqbs;
dest = (uint8_t *)qbs_data;
if (qbs_list_nexti) {
qbs_sp = 0;
for (i = 0; i < qbs_list_nexti; i++) {
if (qbs_list[i] != -1) {
tqbs = (qbs *)qbs_list[i];
if ((tqbs->chr - dest) > 32) {
if (tqbs->len) {
memmove(dest, tqbs->chr, tqbs->len);
}
tqbs->chr = dest;
}
dest = tqbs->chr + tqbs->len;
qbs_sp = dest - qbs_data;
}
}
}
if (((qbs_sp * 2) + (bytesrequired + 32)) >= qbs_data_size) {
static uint8_t *oldbase;
oldbase = qbs_data;
qbs_data_size = qbs_data_size * 2 + bytesrequired;
qbs_data = (uint8_t *)realloc(qbs_data, qbs_data_size);
if (qbs_data == NULL)
error(512); // realloc failed!
for (i = 0; i < qbs_list_nexti; i++) {
if (qbs_list[i] != -1) {
tqbs = (qbs *)qbs_list[i];
tqbs->chr = tqbs->chr - oldbase + qbs_data;
}
}
}
return;
}
qbs *qbs_new_txt(const char *txt) {
qbs *newstr;
newstr = qbs_new_descriptor();
if (!txt) { // NULL pointer is converted to a 0-length string
newstr->len = 0;
} else {
newstr->len = strlen(txt);
}
newstr->chr = (uint8_t *)txt;
if (qbs_tmp_list_nexti > qbs_tmp_list_lasti)
qbs_tmp_concat_list();
newstr->tmplisti = qbs_tmp_list_nexti;
qbs_tmp_list[newstr->tmplisti] = (intptr_t)newstr;
qbs_tmp_list_nexti++;
newstr->tmp = 1;
newstr->readonly = 1;
return newstr;
}
qbs *qbs_new_txt_len(const char *txt, int32_t len) {
qbs *newstr;
newstr = qbs_new_descriptor();
newstr->len = len;
newstr->chr = (uint8_t *)txt;
if (qbs_tmp_list_nexti > qbs_tmp_list_lasti)
qbs_tmp_concat_list();
newstr->tmplisti = qbs_tmp_list_nexti;
qbs_tmp_list[newstr->tmplisti] = (intptr_t)newstr;
qbs_tmp_list_nexti++;
newstr->tmp = 1;
newstr->readonly = 1;
return newstr;
}
// note: qbs_new_fixed detects if string is in DBLOCK
qbs *qbs_new_fixed(uint8_t *offset, uint32_t size, uint8_t tmp) {
qbs *newstr;
newstr = qbs_new_descriptor();
newstr->len = size;
newstr->chr = offset;
newstr->fixed = 1;
if (tmp) {
if (qbs_tmp_list_nexti > qbs_tmp_list_lasti)
qbs_tmp_concat_list();
newstr->tmplisti = qbs_tmp_list_nexti;
qbs_tmp_list[newstr->tmplisti] = (intptr_t)newstr;
qbs_tmp_list_nexti++;
newstr->tmp = 1;
} else {
qbs_new_fixed_cmem(offset, size, tmp, newstr);
}
return newstr;
}
qbs *qbs_new(int32_t size, uint8_t tmp) {
static qbs *newstr;
if ((qbs_sp + size + 32) > qbs_data_size)
qbs_concat(size + 32);
newstr = qbs_new_descriptor();
newstr->len = size;
newstr->chr = qbs_data + qbs_sp;
qbs_sp += size + 32;
if (qbs_list_nexti > qbs_list_lasti)
qbs_concat_list();
newstr->listi = qbs_list_nexti;
qbs_list[newstr->listi] = (intptr_t)newstr;
qbs_list_nexti++;
if (tmp) {
if (qbs_tmp_list_nexti > qbs_tmp_list_lasti)
qbs_tmp_concat_list();
newstr->tmplisti = qbs_tmp_list_nexti;
qbs_tmp_list[newstr->tmplisti] = (intptr_t)newstr;
qbs_tmp_list_nexti++;
newstr->tmp = 1;
}
return newstr;
}
qbs *qbs_new_cmem(int32_t size, uint8_t tmp) {
qbs *newstr = qbs_new_descriptor();
if (tmp && qbs_tmp_list_nexti > qbs_tmp_list_lasti)
qbs_tmp_concat_list();
qbs_create_cmem(size, tmp, newstr);
return newstr;
}
void qbs_maketmp(qbs *str) {
// WARNING: assumes str is a non-tmp string in non-cmem
if (qbs_tmp_list_nexti > qbs_tmp_list_lasti)
qbs_tmp_concat_list();
str->tmplisti = qbs_tmp_list_nexti;
qbs_tmp_list[str->tmplisti] = (intptr_t)str;
qbs_tmp_list_nexti++;
str->tmp = 1;
}
qbs *qbs_set(qbs *deststr, qbs *srcstr) {
int32_t i;
qbs *tqbs;
// fixed deststr
if (deststr->fixed) {
if (srcstr->len >= deststr->len) {
memcpy(deststr->chr, srcstr->chr, deststr->len);
} else {
memcpy(deststr->chr, srcstr->chr, srcstr->len);
memset(deststr->chr + srcstr->len, 32, deststr->len - srcstr->len); // pad with spaces
}
goto qbs_set_return;
}
// non-fixed deststr
// can srcstr be acquired by deststr?
if (srcstr->tmp && srcstr->fixed == 0 && srcstr->readonly == 0 && (srcstr->in_cmem == deststr->in_cmem)) {
if (deststr->in_cmem) {
qbs_move_cmem(deststr, srcstr);
} else {
// unlist deststr and acquire srcstr's list index
qbs_list[deststr->listi] = -1;
qbs_list[srcstr->listi] = (intptr_t)deststr;
deststr->listi = srcstr->listi;
}
qbs_tmp_list[srcstr->tmplisti] = -1;
if (srcstr->tmplisti == (qbs_tmp_list_nexti - 1))
qbs_tmp_list_nexti--; // correct last tmp index for performance
deststr->chr = srcstr->chr;
deststr->len = srcstr->len;
qbs_free_descriptor(srcstr);
return deststr; // nb. This return cannot be changed to a goto qbs_set_return!
}
// srcstr is equal length or shorter
if (srcstr->len <= deststr->len) {
memcpy(deststr->chr, srcstr->chr, srcstr->len);
deststr->len = srcstr->len;
goto qbs_set_return;
}
// srcstr is longer
if (deststr->in_cmem) {
qbs_copy_cmem(deststr, srcstr);
goto qbs_set_return;
}
// not in cmem
if (deststr->listi == (qbs_list_nexti - 1)) { // last index
if (((intptr_t)deststr->chr + srcstr->len) <= ((intptr_t)qbs_data + qbs_data_size)) { // space available
memcpy(deststr->chr, srcstr->chr, srcstr->len);
deststr->len = srcstr->len;
qbs_sp = ((intptr_t)deststr->chr) + (intptr_t)deststr->len - (intptr_t)qbs_data;
goto qbs_set_return;
}
goto qbs_set_concat_required;
}
// deststr is not the last index so locate next valid index
i = deststr->listi + 1;
qbs_set_nextindex2:
if (qbs_list[i] != -1) {
tqbs = (qbs *)qbs_list[i];
if (tqbs == srcstr) {
if (srcstr->tmp == 1)
goto skippedtmpsrcindex2;
}
if ((deststr->chr + srcstr->len) > tqbs->chr)
goto qbs_set_concat_required;
memcpy(deststr->chr, srcstr->chr, srcstr->len);
deststr->len = srcstr->len;
goto qbs_set_return;
}
skippedtmpsrcindex2:
i++;
if (i != qbs_list_nexti)
goto qbs_set_nextindex2;
// all next indexes invalid!
qbs_list_nexti = deststr->listi + 1; // adjust nexti
if (((intptr_t)deststr->chr + srcstr->len) <= ((intptr_t)qbs_data + qbs_data_size)) { // space available
memmove(deststr->chr, srcstr->chr, srcstr->len); // overlap possible due to sometimes acquiring srcstr's space
deststr->len = srcstr->len;
qbs_sp = ((intptr_t)deststr->chr) + (intptr_t)deststr->len - (intptr_t)qbs_data;
goto qbs_set_return;
}
qbs_set_concat_required:
// srcstr could not fit in deststr
//"realloc" deststr
qbs_list[deststr->listi] = -1; // unlist
if ((qbs_sp + srcstr->len) > qbs_data_size) { // must concat!
qbs_concat(srcstr->len);
}
if (qbs_list_nexti > qbs_list_lasti)
qbs_concat_list();
deststr->listi = qbs_list_nexti;
qbs_list[qbs_list_nexti] = (intptr_t)deststr;
qbs_list_nexti++; // relist
deststr->chr = qbs_data + qbs_sp;
deststr->len = srcstr->len;
qbs_sp += deststr->len;
memcpy(deststr->chr, srcstr->chr, srcstr->len);
//(fall through to qbs_set_return)
qbs_set_return:
if (srcstr->tmp) { // remove srcstr if it is a tmp string
qbs_free(srcstr);
}
return deststr;
}
qbs *qbs_add(qbs *str1, qbs *str2) {
qbs *tqbs;
if (!str2->len)
return str1; // pass on
if (!str1->len)
return str2; // pass on
// may be possible to acquire str1 or str2's space but...
// 1. check if dest has enough space (because its data is already in the correct place)
// 2. check if source has enough space
// 3. give up
// nb. they would also have to be a tmp, var. len str in ext memory!
// brute force method...
tqbs = qbs_new(str1->len + str2->len, 1);
memcpy(tqbs->chr, str1->chr, str1->len);
memcpy(tqbs->chr + str1->len, str2->chr, str2->len);
// exit(qbs_sp);
if (str1->tmp)
qbs_free(str1);
if (str2->tmp)
qbs_free(str2);
return tqbs;
}
qbs *qbs_ucase(qbs *str) {
if (!str->len)
return str;
qbs *tqbs = NULL;
if (str->tmp && !str->fixed && !str->readonly && !str->in_cmem) {
tqbs = str;
} else {
tqbs = qbs_new(str->len, 1);
memcpy(tqbs->chr, str->chr, str->len);
}
unsigned char *c = tqbs->chr;
for (int32_t i = 0; i < str->len; i++) {
if ((*c >= 'a') && (*c <= 'z'))
*c = *c & 223;
c++;
}
if (tqbs != str && str->tmp)
qbs_free(str);
return tqbs;
}
qbs *qbs_lcase(qbs *str) {
if (!str->len)
return str;
qbs *tqbs = NULL;
if (str->tmp && !str->fixed && !str->readonly && !str->in_cmem) {
tqbs = str;
} else {
tqbs = qbs_new(str->len, 1);
memcpy(tqbs->chr, str->chr, str->len);
}
unsigned char *c = tqbs->chr;
for (int32_t i = 0; i < str->len; i++) {
if ((*c >= 'A') && (*c <= 'Z'))
*c = *c | 32;
c++;
}
if (tqbs != str && str->tmp)
qbs_free(str);
return tqbs;
}
qbs *qbs_left(qbs *str, int32_t l) {
if (l > str->len)
l = str->len;
if (l < 0)
l = 0;
if (l == str->len)
return str; // pass on
if (str->tmp) {
if (!str->fixed) {
if (!str->readonly) {
if (!str->in_cmem) {
str->len = l;
return str;
}
}
}
}
qbs *tqbs;
tqbs = qbs_new(l, 1);
if (l)
memcpy(tqbs->chr, str->chr, l);
if (str->tmp)
qbs_free(str);
return tqbs;
}
qbs *qbs_right(qbs *str, int32_t l) {
if (l > str->len)
l = str->len;
if (l < 0)
l = 0;
if (l == str->len)
return str; // pass on
if (str->tmp) {
if (!str->fixed) {
if (!str->readonly) {
if (!str->in_cmem) {
str->chr = str->chr + (str->len - l);
str->len = l;
return str;
}
}
}
}
qbs *tqbs;
tqbs = qbs_new(l, 1);
if (l)
memcpy(tqbs->chr, str->chr + str->len - l, l);
tqbs->len = l;
if (str->tmp)
qbs_free(str);
return tqbs;
}
void set_qbs_size(intptr_t *target_qbs, int32_t newlength) {
qbs_set((qbs *)(*target_qbs), func_space(newlength));
return;
}
int32_t qbs_equal(qbs *str1, qbs *str2) {
if (str1->len != str2->len)
return 0;
if (memcmp(str1->chr, str2->chr, str1->len) == 0)
return -1;
return 0;
}
int32_t qbs_notequal(qbs *str1, qbs *str2) {
if (str1->len != str2->len)
return -1;
if (memcmp(str1->chr, str2->chr, str1->len) == 0)
return 0;
return -1;
}
int32_t qbs_greaterthan(qbs *str2, qbs *str1) {
// same process as for lessthan; we just reverse the string order
int32_t i, limit, l1, l2;
l1 = str1->len;
l2 = str2->len;
if (!l1)
if (l2)
return -1;
else
return 0;
if (l1 <= l2)
limit = l1;
else
limit = l2;
i = memcmp(str1->chr, str2->chr, limit);
if (i < 0)
return -1;
if (i > 0)
return 0;
if (l1 < l2)
return -1;
return 0;
}
int32_t qbs_lessthan(qbs *str1, qbs *str2) {
int32_t i, limit, l1, l2;
l1 = str1->len;
l2 = str2->len; // no need to get the length of these strings multiple times.
if (!l1)
if (l2)
return -1;
else
return 0; // if one is a null string we known the answer already.
if (l1 <= l2)
limit = l1;
else
limit = l2; // our limit is going to be the length of the smallest string.
i = memcmp(str1->chr, str2->chr, limit); // check only to the length of the shortest string
if (i < 0)
return -1; // if the number is smaller by this point, say so
if (i > 0)
return 0; // if it's larger by this point, say so
// if the number is the same at this point, compare length.
// if the length of the first one is smaller, then the string is smaller. Otherwise the second one is the same string, or longer.
if (l1 < l2)
return -1;
return 0;
}
int32_t qbs_lessorequal(qbs *str1, qbs *str2) {
// same process as lessthan, but we check to see if the lengths are equal here also.
int32_t i, limit, l1, l2;
l1 = str1->len;
l2 = str2->len;
if (!l1)
return -1; // if the first string has no length then it HAS to be smaller or equal to the second
if (l1 <= l2)
limit = l1;
else
limit = l2;
i = memcmp(str1->chr, str2->chr, limit);
if (i < 0)
return -1;
if (i > 0)
return 0;
if (l1 <= l2)
return -1;
return 0;
}
int32_t qbs_greaterorequal(qbs *str2, qbs *str1) {
// same process as for lessorequal; we just reverse the string order
int32_t i, limit, l1, l2;
l1 = str1->len;
l2 = str2->len;
if (!l1)
return -1;
if (l1 <= l2)
limit = l1;
else
limit = l2;
i = memcmp(str1->chr, str2->chr, limit);
if (i < 0)
return -1;
if (i > 0)
return 0;
if (l1 <= l2)
return -1;
return 0;
}
int32_t qbs_asc(qbs *str, uint32_t i) { // uint32 speeds up checking for negative
i--;
if (i < str->len) {
return str->chr[i];
}
error(5);
return 0;
}
int32_t qbs_asc(qbs *str) {
if (str->len)
return str->chr[0];
error(5);
return 0;
}
int32_t qbs_len(qbs *str) {
return str->len;
}
qbs *func_chr(int32_t value) {
qbs *tqbs;
if ((value < 0) || (value > 255)) {
tqbs = qbs_new(0, 1);
error(5);
} else {
tqbs = qbs_new(1, 1);
tqbs->chr[0] = value;
}
return tqbs;
}

227
internal/c/libqb/src/qbs_cmem.cpp Normal file
View file

@ -0,0 +1,227 @@
#include "libqb-common.h"
#include <stdlib.h>
#include <string.h>
#include "cmem.h"
#include "error_handle.h"
#include "qbs.h"
// FIXME: conventional memory should be consolidated into libqb soruce and headers
extern uint32_t qbs_cmem_sp; //=256;
extern uint32_t cmem_sp; //=65536;
// Used to track strings in 16bit memory
static intptr_t *qbs_cmem_list = (intptr_t *)malloc(65536 * sizeof(intptr_t));
static uint32_t qbs_cmem_list_lasti = 65535;
static uint32_t qbs_cmem_list_nexti = 0;
static uint32_t qbs_cmem_descriptor_space = 256; // enough for 64 strings before expansion
// Does not release actual descriptor, simply removes the string from the 'cmem' list
//
// Assumes the string is infact in cmem
void qbs_remove_cmem(qbs *str) {
qbs_cmem_list[str->listi] = -1;
if ((qbs_cmem_list_nexti - 1) == str->listi)
qbs_cmem_list_nexti--;
}
void qbs_cmem_concat_list() {
uint32_t i;
uint32_t d;
qbs *tqbs;
d = 0;
for (i = 0; i < qbs_cmem_list_nexti; i++) {
if (qbs_cmem_list[i] != -1) {
if (i != d) {
tqbs = (qbs *)qbs_cmem_list[i];
tqbs->listi = d;
qbs_cmem_list[d] = (intptr_t)tqbs;
}
d++;
}
}
qbs_cmem_list_nexti = d;
// if string listings are taking up more than half of the list array double the list array's size
if (qbs_cmem_list_nexti >= (qbs_cmem_list_lasti / 2)) {
qbs_cmem_list_lasti *= 2;
qbs_cmem_list = (intptr_t *)realloc(qbs_cmem_list, (qbs_cmem_list_lasti + 1) * sizeof (*qbs_cmem_list));
if (!qbs_cmem_list)
error(509);
}
return;
}
// as the cmem stack has a limit if bytesrequired cannot be met this exits and returns an error
// the cmem stack cannot after all be extended!
// so bytesrequired is only passed to possibly generate an error, or not generate one
void qbs_concat_cmem(uint32_t bytesrequired) {
// this does not change indexing, only ->chr pointers and the location of their data
int32_t i;
uint8_t *dest;
qbs *tqbs;
dest = (uint8_t *)dblock;
qbs_cmem_sp = qbs_cmem_descriptor_space;
if (qbs_cmem_list_nexti) {
for (i = 0; i < qbs_cmem_list_nexti; i++) {
if (qbs_cmem_list[i] != -1) {
tqbs = (qbs *)qbs_cmem_list[i];
if (tqbs->chr != dest) {
if (tqbs->len) {
memmove(dest, tqbs->chr, tqbs->len);
}
tqbs->chr = dest;
// update cmem_descriptor [length][offset]
if (tqbs->cmem_descriptor) {
tqbs->cmem_descriptor[0] = tqbs->len;
tqbs->cmem_descriptor[1] = (uint16_t)(intptr_t)(tqbs->chr - dblock);
}
}
dest += tqbs->len;
qbs_cmem_sp += tqbs->len;
}
}
}
if ((qbs_cmem_sp + bytesrequired) > cmem_sp)
error(513);
return;
}
void qbs_create_cmem(int32_t size, uint8_t tmp, qbs *newstr) {
if ((qbs_cmem_sp + size) > cmem_sp)
qbs_concat_cmem(size);
newstr->len = size;
if ((qbs_cmem_sp + size) > cmem_sp)
qbs_concat_cmem(size);
newstr->chr = (uint8_t *)dblock + qbs_cmem_sp;
qbs_cmem_sp += size;
newstr->in_cmem = 1;
if (qbs_cmem_list_nexti > qbs_cmem_list_lasti)
qbs_cmem_concat_list();
newstr->listi = qbs_cmem_list_nexti;
qbs_cmem_list[newstr->listi] = (intptr_t)newstr;
qbs_cmem_list_nexti++;
if (tmp) {
newstr->tmplisti = qbs_tmp_list_nexti;
qbs_tmp_list[newstr->tmplisti] = (intptr_t)newstr;
qbs_tmp_list_nexti++;
newstr->tmp = 1;
} else {
// alloc string descriptor in DBLOCK (4 bytes)
cmem_sp -= 4;
newstr->cmem_descriptor = (uint16_t *)(dblock + cmem_sp);
if (cmem_sp < qbs_cmem_sp)
error(514);
newstr->cmem_descriptor_offset = cmem_sp;
// update cmem_descriptor [length][offset]
newstr->cmem_descriptor[0] = newstr->len;
newstr->cmem_descriptor[1] = (uint16_t)(intptr_t)(newstr->chr - dblock);
}
}
// Attempts to create the string in cmem at the given offset.
//
// The return indicates whether it was successful
bool qbs_new_fixed_cmem(uint8_t *offset, uint32_t size, uint8_t tmp, qbs *newstr) {
// is it in DBLOCK?
if ((offset > (cmem + 1280)) && (offset < (cmem + 66816))) {
// alloc string descriptor in DBLOCK (4 bytes)
cmem_sp -= 4;
newstr->cmem_descriptor = (uint16_t *)(dblock + cmem_sp);
if (cmem_sp < qbs_cmem_sp)
error(515);
newstr->cmem_descriptor_offset = cmem_sp;
// update cmem_descriptor [length][offset]
newstr->cmem_descriptor[0] = newstr->len;
newstr->cmem_descriptor[1] = (uint16_t)(intptr_t)(newstr->chr - dblock);
return true;
}
return false;
}
// Assumes you've already checked that this is valid - both strings should be
// in cmem list, and srcstr should be acquirable by deststr with no copy.
//
// Does not do all the work, the return string move for non-cmem still needs to
// happen
void qbs_move_cmem(qbs *deststr, qbs *srcstr) {
// unlist deststr and acquire srcstr's list index
qbs_cmem_list[deststr->listi] = -1;
qbs_cmem_list[srcstr->listi] = (intptr_t)deststr;
deststr->listi = srcstr->listi;
if (deststr->cmem_descriptor) {
deststr->cmem_descriptor[0] = srcstr->len;
deststr->cmem_descriptor[1] = (uint16_t)(intptr_t)(srcstr->chr - dblock);
}
}
void qbs_copy_cmem(qbs *deststr, qbs *srcstr) {
int32_t i;
qbs *tqbs;
if (deststr->listi == (qbs_cmem_list_nexti - 1)) { // last index
if (((intptr_t)deststr->chr + srcstr->len) <= (dblock + cmem_sp)) { // space available
memcpy(deststr->chr, srcstr->chr, srcstr->len);
deststr->len = srcstr->len;
qbs_cmem_sp = ((intptr_t)deststr->chr) + (intptr_t)deststr->len - dblock;
goto update_cmem_descriptor;
}
goto qbs_set_cmem_concat_required;
}
// deststr is not the last index so locate next valid index
i = deststr->listi + 1;
qbs_set_nextindex:
if (qbs_cmem_list[i] != -1) {
tqbs = (qbs *)qbs_cmem_list[i];
if (tqbs == srcstr) {
if (srcstr->tmp == 1)
goto skippedtmpsrcindex;
}
if ((deststr->chr + srcstr->len) > tqbs->chr)
goto qbs_set_cmem_concat_required;
memcpy(deststr->chr, srcstr->chr, srcstr->len);
deststr->len = srcstr->len;
goto update_cmem_descriptor;
}
skippedtmpsrcindex:
i++;
if (i != qbs_cmem_list_nexti)
goto qbs_set_nextindex;
// all next indexes invalid!
qbs_cmem_list_nexti = deststr->listi + 1; // adjust nexti
if (((intptr_t)deststr->chr + srcstr->len) <= (dblock + cmem_sp)) { // space available
memmove(deststr->chr, srcstr->chr, srcstr->len); // overlap possible due to sometimes aquiring srcstr's space
deststr->len = srcstr->len;
qbs_cmem_sp = ((intptr_t)deststr->chr) + (intptr_t)deststr->len - dblock;
goto update_cmem_descriptor;
}
qbs_set_cmem_concat_required:
// srcstr could not fit in deststr
//"realloc" deststr
qbs_cmem_list[deststr->listi] = -1; // unlist
if ((qbs_cmem_sp + srcstr->len) > cmem_sp) { // must concat!
qbs_concat_cmem(srcstr->len);
}
if (qbs_cmem_list_nexti > qbs_cmem_list_lasti)
qbs_cmem_concat_list();
deststr->listi = qbs_cmem_list_nexti;
qbs_cmem_list[qbs_cmem_list_nexti] = (intptr_t)deststr;
qbs_cmem_list_nexti++; // relist
deststr->chr = (uint8_t *)dblock + qbs_cmem_sp;
deststr->len = srcstr->len;
qbs_cmem_sp += deststr->len;
memcpy(deststr->chr, srcstr->chr, srcstr->len);
update_cmem_descriptor:
// update cmem_descriptor [length][offset]
if (deststr->cmem_descriptor) {
deststr->cmem_descriptor[0] = deststr->len;
deststr->cmem_descriptor[1] = (uint16_t)(intptr_t)(deststr->chr - dblock);
}
}

256
internal/c/libqb/src/qbs_str.cpp Normal file
View file

@ -0,0 +1,256 @@
#include "libqb-common.h"
#include <string.h>
#include <stdlib.h>
#include <stdio.h>
#include "qbs.h"
// STR() functions
// singed integers
qbs *qbs_str(int64_t value) {
qbs *tqbs;
tqbs = qbs_new(20, 1);
#ifdef QB64_WINDOWS
tqbs->len = sprintf((char *)tqbs->chr, "% I64i", value);
#else
tqbs->len = sprintf((char *)tqbs->chr, "% lli", value);
#endif
return tqbs;
}
qbs *qbs_str(int32_t value) {
qbs *tqbs;
tqbs = qbs_new(11, 1);
tqbs->len = sprintf((char *)tqbs->chr, "% i", value);
return tqbs;
}
qbs *qbs_str(int16_t value) {
qbs *tqbs;
tqbs = qbs_new(6, 1);
tqbs->len = sprintf((char *)tqbs->chr, "% i", value);
return tqbs;
}
qbs *qbs_str(int8_t value) {
qbs *tqbs;
tqbs = qbs_new(4, 1);
tqbs->len = sprintf((char *)tqbs->chr, "% i", value);
return tqbs;
}
// unsigned integers
qbs *qbs_str(uint64_t value) {
qbs *tqbs;
tqbs = qbs_new(21, 1);
#ifdef QB64_WINDOWS
tqbs->len = sprintf((char *)tqbs->chr, " %I64u", value);
#else
tqbs->len = sprintf((char *)tqbs->chr, " %llu", value);
#endif
return tqbs;
}
qbs *qbs_str(uint32_t value) {
qbs *tqbs;
tqbs = qbs_new(11, 1);
tqbs->len = sprintf((char *)tqbs->chr, " %u", value);
return tqbs;
}
qbs *qbs_str(uint16_t value) {
qbs *tqbs;
tqbs = qbs_new(6, 1);
tqbs->len = sprintf((char *)tqbs->chr, " %u", value);
return tqbs;
}
qbs *qbs_str(uint8_t value) {
qbs *tqbs;
tqbs = qbs_new(4, 1);
tqbs->len = sprintf((char *)tqbs->chr, " %u", value);
return tqbs;
}
uint8_t func_str_fmt[7];
uint8_t qbs_str_buffer[32];
uint8_t qbs_str_buffer2[32];
qbs *qbs_str(float value) {
static qbs *tqbs;
tqbs = qbs_new(16, 1);
static int32_t l, i, i2, i3, digits, exponent;
l = sprintf((char *)&qbs_str_buffer, "% .6E", value);
// IMPORTANT: assumed l==14
if (l == 13) {
memmove(&qbs_str_buffer[12], &qbs_str_buffer[11], 2);
qbs_str_buffer[11] = 48;
l = 14;
}
digits = 7;
for (i = 8; i >= 1; i--) {
if (qbs_str_buffer[i] == 48) {
digits--;
} else {
if (qbs_str_buffer[i] != 46)
break;
}
} // i
// no significant digits? simply return 0
if (digits == 0) {
tqbs->len = 2;
tqbs->chr[0] = 32;
tqbs->chr[1] = 48; // tqbs=[space][0]
return tqbs;
}
// calculate exponent
exponent = (qbs_str_buffer[11] - 48) * 100 + (qbs_str_buffer[12] - 48) * 10 + (qbs_str_buffer[13] - 48);
if (qbs_str_buffer[10] == 45)
exponent = -exponent;
if ((exponent <= 6) && ((exponent - digits) >= -8))
goto asdecimal;
// fix up exponent to conform to QBASIC standards
// i. cull trailing 0's after decimal point (use digits to help)
// ii. cull leading 0's of exponent
i3 = 0;
i2 = digits + 2;
if (digits == 1)
i2--; // don't include decimal point
for (i = 0; i < i2; i++) {
tqbs->chr[i3] = qbs_str_buffer[i];
i3++;
}
for (i = 9; i <= 10; i++) {
tqbs->chr[i3] = qbs_str_buffer[i];
i3++;
}
exponent = abs(exponent);
// i2=13;
// if (exponent>9) i2=12;
i2 = 12; // override: if exponent is less than 10 still display a leading 0
if (exponent > 99)
i2 = 11;
for (i = i2; i <= 13; i++) {
tqbs->chr[i3] = qbs_str_buffer[i];
i3++;
}
tqbs->len = i3;
return tqbs;
/////////////////////
asdecimal:
// calculate digits after decimal point in var. i
i = -(exponent - digits + 1);
if (i < 0)
i = 0;
func_str_fmt[0] = 37; //"%"
func_str_fmt[1] = 32; //" "
func_str_fmt[2] = 46; //"."
func_str_fmt[3] = i + 48;
func_str_fmt[4] = 102; //"f"
func_str_fmt[5] = 0;
tqbs->len = sprintf((char *)tqbs->chr, (const char *)&func_str_fmt, value);
if (tqbs->chr[1] == 48) { // must manually cull leading 0
memmove(tqbs->chr + 1, tqbs->chr + 2, tqbs->len - 2);
tqbs->len--;
}
return tqbs;
}
qbs *qbs_str(double value) {
static qbs *tqbs;
tqbs = qbs_new(32, 1);
static int32_t l, i, i2, i3, digits, exponent;
l = sprintf((char *)&qbs_str_buffer, "% .15E", value);
// IMPORTANT: assumed l==23
if (l == 22) {
memmove(&qbs_str_buffer[21], &qbs_str_buffer[20], 2);
qbs_str_buffer[20] = 48;
l = 23;
}
// check if the 16th significant digit is 9, if it is round to 15 significant digits
if (qbs_str_buffer[17] == 57) {
sprintf((char *)&qbs_str_buffer2, "% .14E", value);
memmove(&qbs_str_buffer, &qbs_str_buffer2, 17);
qbs_str_buffer[17] = 48;
}
qbs_str_buffer[18] = 68; // change E to D (QBASIC standard)
digits = 16;
for (i = 17; i >= 1; i--) {
if (qbs_str_buffer[i] == 48) {
digits--;
} else {
if (qbs_str_buffer[i] != 46)
break;
}
} // i
// no significant digits? simply return 0
if (digits == 0) {
tqbs->len = 2;
tqbs->chr[0] = 32;
tqbs->chr[1] = 48; // tqbs=[space][0]
return tqbs;
}
// calculate exponent
exponent = (qbs_str_buffer[20] - 48) * 100 + (qbs_str_buffer[21] - 48) * 10 + (qbs_str_buffer[22] - 48);
if (qbs_str_buffer[19] == 45)
exponent = -exponent;
// OLD if ((exponent<=15)&&((exponent-digits)>=-16)) goto asdecimal;
if ((exponent <= 15) && ((exponent - digits) >= -17))
goto asdecimal;
// fix up exponent to conform to QBASIC standards
// i. cull trailing 0's after decimal point (use digits to help)
// ii. cull leading 0's of exponent
i3 = 0;
i2 = digits + 2;
if (digits == 1)
i2--; // don't include decimal point
for (i = 0; i < i2; i++) {
tqbs->chr[i3] = qbs_str_buffer[i];
i3++;
}
for (i = 18; i <= 19; i++) {
tqbs->chr[i3] = qbs_str_buffer[i];
i3++;
}
exponent = abs(exponent);
// i2=22;
// if (exponent>9) i2=21;
i2 = 21; // override: if exponent is less than 10 still display a leading 0
if (exponent > 99)
i2 = 20;
for (i = i2; i <= 22; i++) {
tqbs->chr[i3] = qbs_str_buffer[i];
i3++;
}
tqbs->len = i3;
return tqbs;
/////////////////////
asdecimal:
// calculate digits after decimal point in var. i
i = -(exponent - digits + 1);
if (i < 0)
i = 0;
func_str_fmt[0] = 37; //"%"
func_str_fmt[1] = 32; //" "
func_str_fmt[2] = 46; //"."
if (i > 9) {
func_str_fmt[3] = 49; //"1"
func_str_fmt[4] = (i - 10) + 48;
} else {
func_str_fmt[3] = 48; //"0"
func_str_fmt[4] = i + 48;
}
func_str_fmt[5] = 102; //"f"
func_str_fmt[6] = 0;
tqbs->len = sprintf((char *)tqbs->chr, (const char *)&func_str_fmt, value);
if (tqbs->chr[1] == 48) { // must manually cull leading 0
memmove(tqbs->chr + 1, tqbs->chr + 2, tqbs->len - 2);
tqbs->len--;
}
return tqbs;
}
qbs *qbs_str(long double value) {
// not fully implemented
return qbs_str((double)value);
}

361
internal/c/libqb/src/string_functions.cpp Normal file
View file

@ -0,0 +1,361 @@
#include "libqb-common.h"
#include <string.h>
#include <stdlib.h>
#include "error_handle.h"
#include "qbs.h"
extern qbs *nothingstring;
void sub_lset(qbs *dest, qbs *source) {
if (is_error_pending())
return;
if (source->len >= dest->len) {
if (dest->len)
memcpy(dest->chr, source->chr, dest->len);
goto field_check;
}
if (source->len)
memcpy(dest->chr, source->chr, source->len);
memset(dest->chr + source->len, 32, dest->len - source->len);
field_check:
if (dest->field)
lrset_field(dest);
}
void sub_rset(qbs *dest, qbs *source) {
if (is_error_pending())
return;
if (source->len >= dest->len) {
if (dest->len)
memcpy(dest->chr, source->chr, dest->len);
goto field_check;
}
if (source->len)
memcpy(dest->chr + dest->len - source->len, source->chr, source->len);
memset(dest->chr, 32, dest->len - source->len);
field_check:
if (dest->field)
lrset_field(dest);
}
qbs *func_space(int32_t spaces) {
static qbs *tqbs;
if (spaces < 0)
spaces = 0;
tqbs = qbs_new(spaces, 1);
if (spaces)
memset(tqbs->chr, 32, spaces);
return tqbs;
}
qbs *func_string(int32_t characters, int32_t asciivalue) {
static qbs *tqbs;
if (characters < 0)
characters = 0;
tqbs = qbs_new(characters, 1);
if (characters)
memset(tqbs->chr, asciivalue & 0xFF, characters);
return tqbs;
}
int32_t func_instr(int32_t start, qbs *str, qbs *substr, int32_t passed) {
// QB64 difference: start can be 0 or negative
// justification-start could be larger than the length of string to search in QBASIC
static uint8_t *limit, *base;
static uint8_t firstc;
if (!passed)
start = 1;
if (!str->len)
return 0;
if (start < 1) {
start = 1;
if (!substr->len)
return 0;
}
if (start > str->len)
return 0;
if (!substr->len)
return start;
if ((start + substr->len - 1) > str->len)
return 0;
limit = str->chr + str->len;
firstc = substr->chr[0];
base = str->chr + start - 1;
nextchar:
base = (uint8_t *)memchr(base, firstc, limit - base);
if (!base)
return 0;
if ((base + substr->len) > limit)
return 0;
if (!memcmp(base, substr->chr, substr->len))
return base - str->chr + 1;
base++;
if ((base + substr->len) > limit)
return 0;
goto nextchar;
}
int32_t func__instrrev(int32_t start, qbs *str, qbs *substr, int32_t passed) {
if (!str->len)
return 0;
if (substr->len > str->len)
return 0;
if (!passed) {
if (substr->len == str->len) {
if (!memcmp(str->chr, substr->chr, str->len))
return 1;
}
start = str->len - substr->len + 1;
}
if (start < 1) {
start = str->len - substr->len + 1;
}
if (start > str->len)
start = str->len - substr->len + 1;
if (!substr->len)
return start - 1;
if ((start + substr->len - 1) > str->len)
start = str->len - substr->len + 1;
int32_t searchForward = 0, lastFound = 0, result = 0;
do {
searchForward = func_instr(searchForward + 1, str, substr, 1);
if (searchForward > 0) {
lastFound = searchForward;
if (lastFound <= start)
result = lastFound;
if (lastFound > start)
break;
}
} while (searchForward > 0);
return result;
}
void sub_mid(qbs *dest, int32_t start, int32_t l, qbs *src, int32_t passed) {
if (is_error_pending())
return;
static int32_t src_offset;
if (!passed)
l = src->len;
src_offset = 0;
if (dest == nothingstring)
return; // quiet exit, error has already been reported!
if (start < 1) {
l = l + start - 1;
src_offset = -start + 1; // src_offset is a byte offset with base 0!
start = 1;
}
if (l <= 0)
return;
if (start > dest->len)
return;
if ((start + l - 1) > dest->len)
l = dest->len - start + 1;
// start and l are now reflect a valid region within dest
if (src_offset >= src->len)
return;
if (l > (src->len - src_offset))
l = src->len - src_offset;
// src_offset and l now reflect a valid region within src
if (dest == src) {
if ((start - 1) != src_offset)
memmove(dest->chr + start - 1, src->chr + src_offset, l);
} else {
memcpy(dest->chr + start - 1, src->chr + src_offset, l);
}
}
qbs *func_mid(qbs *str, int32_t start, int32_t l, int32_t passed) {
static qbs *tqbs;
if (passed) {
if (start < 1) {
l = l - 1 + start;
start = 1;
}
if ((l >= 1) && (start <= str->len)) {
if ((start + l) > str->len)
l = str->len - start + 1;
} else {
l = 0;
start = 1; // nothing!
}
} else {
if (start < 1)
start = 1;
l = str->len - start + 1;
if (l < 1) {
l = 0;
start = 1; // nothing!
}
}
if ((start == 1) && (l == str->len))
return str; // pass on
if (str->tmp) {
if (!str->fixed) {
if (!str->readonly) {
if (!str->in_cmem) { // acquire
str->chr = str->chr + (start - 1);
str->len = l;
return str;
}
}
}
}
tqbs = qbs_new(l, 1);
if (l)
memcpy(tqbs->chr, str->chr + start - 1, l);
if (str->tmp)
qbs_free(str);
return tqbs;
}
qbs *qbs_ltrim(qbs *str) {
if (!str->len)
return str; // pass on
if (*str->chr != 32)
return str; // pass on
if (str->tmp) {
if (!str->fixed) {
if (!str->readonly) {
if (!str->in_cmem) { // acquire?
qbs_ltrim_nextchar:
if (*str->chr == 32) {
str->chr++;
if (--str->len)
goto qbs_ltrim_nextchar;
}
return str;
}
}
}
}
int32_t i;
i = 0;
qbs_ltrim_nextchar2:
if (str->chr[i] == 32) {
i++;
if (i < str->len)
goto qbs_ltrim_nextchar2;
}
qbs *tqbs;
tqbs = qbs_new(str->len - i, 1);
if (tqbs->len)
memcpy(tqbs->chr, str->chr + i, tqbs->len);
if (str->tmp)
qbs_free(str);
return tqbs;
}
qbs *qbs_rtrim(qbs *str) {
if (!str->len)
return str; // pass on
if (str->chr[str->len - 1] != 32)
return str; // pass on
if (str->tmp) {
if (!str->fixed) {
if (!str->readonly) {
if (!str->in_cmem) { // acquire?
qbs_rtrim_nextchar:
if (str->chr[str->len - 1] == 32) {
if (--str->len)
goto qbs_rtrim_nextchar;
}
return str;
}
}
}
}
int32_t i;
i = str->len;
qbs_rtrim_nextchar2:
if (str->chr[i - 1] == 32) {
i--;
if (i)
goto qbs_rtrim_nextchar2;
}
// i is the number of characters to keep
qbs *tqbs;
tqbs = qbs_new(i, 1);
if (i)
memcpy(tqbs->chr, str->chr, i);
if (str->tmp)
qbs_free(str);
return tqbs;
}
qbs *qbs__trim(qbs *str) { return qbs_rtrim(qbs_ltrim(str)); }
int32_t func__str_nc_compare(qbs *s1, qbs *s2) {
int32_t limit, l1, l2;
int32_t v1, v2;
unsigned char *c1 = s1->chr, *c2 = s2->chr;
l1 = s1->len;
l2 = s2->len; // no need to get the length of these strings multiple times.
if (!l1) {
if (l2)
return -1;
else
return 0; // if one is a null string we known the answer already.
}
if (!l2)
return 1;
if (l1 <= l2)
limit = l1;
else
limit = l2; // our limit is going to be the length of the smallest string.
for (int32_t i = 0; i < limit; i++) { // check the length of our string
v1 = *c1;
v2 = *c2;
if ((v1 > 64) && (v1 < 91))
v1 = v1 | 32;
if ((v2 > 64) && (v2 < 91))
v2 = v2 | 32;
if (v1 < v2)
return -1;
if (v1 > v2)
return 1;
c1++;
c2++;
}
if (l1 < l2)
return -1;
if (l1 > l2)
return 1;
return 0;
}
int32_t func__str_compare(qbs *s1, qbs *s2) {
int32_t i, limit, l1, l2;
l1 = s1->len;
l2 = s2->len; // no need to get the length of these strings multiple times.
if (!l1) {
if (l2)
return -1;
else
return 0; // if one is a null string we known the answer already.
}
if (!l2)
return 1;
if (l1 <= l2)
limit = l1;
else
limit = l2;
i = memcmp(s1->chr, s2->chr, limit);
if (i < 0)
return -1;
if (i > 0)
return 1;
if (l1 < l2)
return -1;
if (l1 > l2)
return 1;
return 0;
}

159
internal/c/qbx.cpp
View file

@ -1,6 +1,7 @@
#include "audio.h"
#include "common.h"
#include "compression.h"
#include "command.h"
#include "datetime.h"
#include "event.h"
#include "extended_math.h"
@ -9,6 +10,9 @@
#include "font.h"
#include "gui.h"
#include "image.h"
#include "qbs.h"
#include "error_handle.h"
#include "mem.h"
#include "rounding.h"
extern int32 func__cinp(int32 toggle,
@ -117,49 +121,6 @@ extern void sub__displayorder(int32 method1, int32 method2, int32 method3,
extern int64 GetTicks();
extern int32 func__memexists(void *blk);
extern void sub__memfill(mem_block *dblk, ptrszint doff, ptrszint dbytes,
ptrszint soff, ptrszint sbytes);
extern void sub__memfill_nochecks(ptrszint doff, ptrszint dbytes, ptrszint soff,
ptrszint sbytes);
extern void sub__memfill_1(mem_block *dblk, ptrszint doff, ptrszint dbytes,
int8 val);
extern void sub__memfill_nochecks_1(ptrszint doff, ptrszint dbytes, int8 val);
extern void sub__memfill_2(mem_block *dblk, ptrszint doff, ptrszint dbytes,
int16 val);
extern void sub__memfill_nochecks_2(ptrszint doff, ptrszint dbytes, int16 val);
extern void sub__memfill_4(mem_block *dblk, ptrszint doff, ptrszint dbytes,
int32 val);
extern void sub__memfill_nochecks_4(ptrszint doff, ptrszint dbytes, int32 val);
extern void sub__memfill_8(mem_block *dblk, ptrszint doff, ptrszint dbytes,
int64 val);
extern void sub__memfill_nochecks_8(ptrszint doff, ptrszint dbytes, int64 val);
extern void sub__memfill_SINGLE(mem_block *dblk, ptrszint doff, ptrszint dbytes,
float val);
extern void sub__memfill_nochecks_SINGLE(ptrszint doff, ptrszint dbytes,
float val);
extern void sub__memfill_DOUBLE(mem_block *dblk, ptrszint doff, ptrszint dbytes,
double val);
extern void sub__memfill_nochecks_DOUBLE(ptrszint doff, ptrszint dbytes,
double val);
extern void sub__memfill_FLOAT(mem_block *dblk, ptrszint doff, ptrszint dbytes,
long double val);
extern void sub__memfill_nochecks_FLOAT(ptrszint doff, ptrszint dbytes,
long double val);
extern void sub__memfill_OFFSET(mem_block *dblk, ptrszint doff, ptrszint dbytes,
ptrszint val);
extern void sub__memfill_nochecks_OFFSET(ptrszint doff, ptrszint dbytes,
ptrszint val);
extern void *func__memget(mem_block *blk, ptrszint off, ptrszint bytes);
extern void new_mem_lock();
extern void free_mem_lock(mem_lock *lock);
extern mem_block func__mem(ptrszint offset, ptrszint size, int32 type,
ptrszint elementsize, mem_lock *lock);
extern mem_block func__mem_at_offset(ptrszint offset, ptrszint size);
extern void sub__memfree(void *);
extern void sub__memcopy(void *sblk, ptrszint soff, ptrszint bytes, void *dblk,
ptrszint doff);
extern mem_block func__memnew(ptrszint);
extern mem_block func__memimage(int32, int32);
extern int64 func__shellhide(qbs *str);
@ -275,9 +236,6 @@ extern uint32 *rm32();
extern void cpu_call();
extern int64 build_int64(uint32 val2, uint32 val1);
extern uint64 build_uint64(uint32 val2, uint32 val1);
extern void fix_error();
extern double get_error_erl();
extern uint32 get_error_err();
extern char *human_error(int32 errorcode);
extern void end();
extern int32 stop_program_state();
@ -289,28 +247,7 @@ extern void sub_defseg(int32 segment, int32 passed);
extern int32 func_peek(int32 offset);
extern void sub_poke(int32 offset, int32 value);
extern void more_return_points();
extern qbs *qbs_new_descriptor();
extern void qbs_free_descriptor(qbs *str);
extern void qbs_free(qbs *str);
extern void qbs_cmem_concat_list();
extern void qbs_concat_list();
extern void qbs_tmp_concat_list();
extern void qbs_concat(uint32 bytesrequired);
extern void qbs_concat_cmem(uint32 bytesrequired);
extern qbs *qbs_new_cmem(int32 size, uint8 tmp);
extern qbs *qbs_new_txt(const char *txt);
extern qbs *qbs_new_txt_len(const char *txt, int32 len);
extern qbs *qbs_new_fixed(uint8 *offset, uint32 size, uint8 tmp);
extern qbs *qbs_new(int32 size, uint8 tmp);
extern void set_qbs_size(ptrszint *target_qbs, int32 newlength);
extern qbs *qbs_set(qbs *deststr, qbs *srcstr);
extern qbs *qbs_add(qbs *str1, qbs *str2);
extern qbs *qbs_ucase(qbs *str);
extern qbs *qbs_lcase(qbs *str);
extern qbs *func_chr(int32 value);
extern qbs *func_varptr_helper(uint8 type, uint16 offset);
extern qbs *qbs_left(qbs *str, int32 l);
extern qbs *qbs_right(qbs *str, int32 l);
extern qbs *func_mksmbf(float val);
extern qbs *func_mkdmbf(double val);
extern float func_cvsmbf(qbs *str);
@ -334,26 +271,6 @@ extern int32 func__str_nc_compare(qbs *s1, qbs *s2);
extern int32 func__str_compare(qbs *s1, qbs *s2);
extern qbs *qbs_inkey();
extern void sub__keyclear(int32 buf, int32 passed);
extern qbs *qbs_str(int64 value);
extern qbs *qbs_str(int32 value);
extern qbs *qbs_str(int16 value);
extern qbs *qbs_str(int8 value);
extern qbs *qbs_str(uint64 value);
extern qbs *qbs_str(uint32 value);
extern qbs *qbs_str(uint16 value);
extern qbs *qbs_str(uint8 value);
extern qbs *qbs_str(float value);
extern qbs *qbs_str(double value);
extern qbs *qbs_str(long double value);
extern int32 qbs_equal(qbs *str1, qbs *str2);
extern int32 qbs_notequal(qbs *str1, qbs *str2);
extern int32 qbs_greaterthan(qbs *str1, qbs *str2);
extern int32 qbs_lessthan(qbs *str1, qbs *str2);
extern int32 qbs_lessorequal(qbs *str1, qbs *str2);
extern int32 qbs_greaterorequal(qbs *str1, qbs *str2);
extern int32 qbs_asc(qbs *);
extern int32 qbs_asc(qbs *, uint32);
extern int32 qbs_len(qbs *str);
extern void lineclip(int32 x1, int32 y1, int32 x2, int32 y2, int32 xmin,
int32 ymin, int32 xmax, int32 ymax);
extern void qbg_palette(uint32 attribute, uint32 col, int32 passed);
@ -510,8 +427,6 @@ extern qbs *func_input(int32 n, int32 i, int32 passed);
extern int32 func__statusCode(int32 handle);
extern double func_sqr(double value);
extern qbs *func_command(int32 index, int32 passed);
extern int32 func__commandcount();
extern long double pow2(long double x, long double y);
extern int32 func_freefile();
extern void sub__mousehide();
@ -633,13 +548,10 @@ extern void setbits(uint32 bsize, uint8 *base, ptrszint i, int64 val);
// shared global variables
extern int32 sleep_break;
extern uint64 mem_lock_id;
extern mem_lock *mem_lock_tmp;
extern int64 exit_code;
extern int32 lock_mainloop; // 0=unlocked, 1=lock requested, 2=locked
extern int64 device_event_index;
extern int32 exit_ok;
extern qbs *func_command_str;
int32 timer_event_occurred = 0; // inc/dec as each GOSUB to QBMAIN ()
// begins/ends
int32 timer_event_id = 0;
@ -648,32 +560,23 @@ int32 key_event_id = 0;
int32 strig_event_occurred = 0; // inc/dec as each GOSUB to QBMAIN ()
// begins/ends
int32 strig_event_id = 0;
uint32 ercl;
uint32 inclercl;
char *includedfilename;
uint16 call_absolute_offsets[256];
uint32 dbgline;
uint32 qbs_cmem_sp = 256;
uint32 cmem_sp = 65536;
ptrszint dblock; // 32bit offset of dblock
intptr_t dblock; // 32bit offset of dblock
uint8 close_program = 0;
int32 tab_spc_cr_size = 1; // 1=PRINT(default), 2=FILE
int32 tab_fileno = 0; // only valid if tab_spc_cr_size=2
int32 tab_LPRINT = 0; // 1=dest is LPRINT image
uint64 *nothingvalue; // a pointer to 8 empty bytes in dblock
uint32 error_err = 0;
double error_erl = 0;
uint32 qbs_tmp_list_nexti = 1;
uint32 error_occurred = 0;
uint32 new_error = 0;
uint32 bkp_new_error = 0;
qbs *nothingstring;
uint32 qbevent = 0;
uint8 suspend_program = 0;
uint8 stop_program = 0;
uint32 error_retry = 0;
uint8 cmem[1114099]; // 16*65535+65535+3 (enough for highest referencable dword
uint8_t cmem[1114099]; // 16*65535+65535+3 (enough for highest referencable dword
// in conv memory)
uint8 *cmem_static_pointer = &cmem[0] + 1280 + 65536;
uint8 *cmem_dynamic_base = &cmem[0] + 655360;
@ -681,8 +584,7 @@ uint8 *mem_static;
uint8 *mem_static_pointer;
uint8 *mem_static_limit;
double last_line = 0;
uint32 error_goto_line = 0;
uint32 error_handling = 0;
uint32 next_return_point = 0;
uint32 *return_point = (uint32 *)malloc(4 * 16384);
uint32 return_points = 16384;
@ -776,15 +678,6 @@ void swap_block(void *a, void *b, uint32 bytes) {
*b8++ = c;
}
}
extern ptrszint *qbs_tmp_list;
template <typename T> static T qbs_cleanup(uint32 base, T passvalue) {
while (qbs_tmp_list_nexti > base) {
qbs_tmp_list_nexti--;
if (qbs_tmp_list[qbs_tmp_list_nexti] != -1)
qbs_free((qbs *)qbs_tmp_list[qbs_tmp_list_nexti]);
} // clear any temp. strings created
return passvalue;
}
// force abs to return floating point numbers correctly
@ -807,7 +700,7 @@ ptrszint check_lbound(ptrszint *array, int32 index, int32 num_indexes) {
static ptrszint ret;
disableEvents = 1;
ret = func_lbound((ptrszint *)(*array), index, num_indexes);
new_error = 0;
clear_error();
disableEvents = 0;
return ret;
}
@ -816,7 +709,7 @@ ptrszint check_ubound(ptrszint *array, int32 index, int32 num_indexes) {
static ptrszint ret;
disableEvents = 1;
ret = func_ubound((ptrszint *)(*array), index, num_indexes);
new_error = 0;
clear_error();
disableEvents = 0;
return ret;
}
@ -1144,18 +1037,6 @@ void sub__display();
void sub__autodisplay();
int32 func__autodisplay();
int32 func__errorline() { return ercl; }
int32 func__inclerrorline() { return inclercl; }
qbs *func__inclerrorfile() { return qbs_new_txt(includedfilename); }
qbs *func__errormessage(int32 errorcode, int32 passed) {
if (!passed)
errorcode = get_error_err();
return qbs_new_txt(human_error(errorcode));
}
void chain_input() {
// note: common data or not, every program must check for chained data,
// it could be sharing files or screen state
@ -1216,7 +1097,7 @@ void chain_input() {
}
void sub_chain(qbs *f) {
if (new_error)
if (is_error_pending())
return;
#ifdef QB64_WINDOWS
@ -1775,7 +1656,7 @@ int32 onstrig_inprogress = 0;
void onstrig_setup(int32 i, int32 controller, int32 controller_passed,
uint32 id, int64 pass) {
// note: pass is ignored by ids not requiring a pass value
if (new_error)
if (is_error_pending())
return;
if (i < 0 || i > 65535) {
error(5);
@ -1812,7 +1693,7 @@ void onstrig_setup(int32 i, int32 controller, int32 controller_passed,
void sub_strig(int32 i, int32 controller, int32 option, int32 passed) {
// ref: "[(?[,?])]{ON|OFF|STOP}"
if (new_error)
if (is_error_pending())
return;
// Note: QuickBASIC ignores STRIG ON and STRIG OFF statements--the
// statements are provided for compatibility with earlier versions,
@ -1876,7 +1757,7 @@ int32 onkey_inprogress = 0;
void onkey_setup(int32 i, uint32 id, int64 pass) {
// note: pass is ignored by ids not requiring a pass value
if (new_error)
if (is_error_pending())
return;
if ((i < 1) || (i > 31)) {
error(5);
@ -1889,7 +1770,7 @@ void onkey_setup(int32 i, uint32 id, int64 pass) {
void sub_key(int32 i, int32 option) {
// ref: "(?){ON|OFF|STOP}"
if (new_error)
if (is_error_pending())
return;
if ((i < 0) || (i > 31)) {
error(5);
@ -1939,7 +1820,7 @@ void stop_timers() {
void start_timers() { ontimerthread_lock = 0; }
int32 func__freetimer() {
if (new_error)
if (is_error_pending())
return 0;
static int32 i;
if (ontimer_freelist_available) {
@ -1978,7 +1859,7 @@ void freetimer(int32 i) {
void ontimer_setup(int32 i, double sec, uint32 id, int64 pass) {
// note: pass is ignored by ids not requiring a pass value
if (new_error)
if (is_error_pending())
return;
if ((i < 0) || (i >= ontimer_nextfree)) {
error(5);
@ -1999,7 +1880,7 @@ void ontimer_setup(int32 i, double sec, uint32 id, int64 pass) {
void sub_timer(int32 i, int32 option, int32 passed) {
// ref: "[(?)]{ON|OFF|STOP|FREE}"
if (new_error)
if (is_error_pending())
return;
if (!passed)
i = 0;
@ -2221,10 +2102,8 @@ void evnt(uint32 linenumber, uint32 inclinenumber, const char *incfilename) {
Sleep(10);
}
if (new_error) {
ercl = linenumber;
inclercl = inclinenumber;
includedfilename = (char *)incfilename;
if (is_error_pending()) {
error_set_line(linenumber, inclinenumber, incfilename);
fix_error();
if (error_retry) {
error_retry = 0;

80
source/qb64pe.bas
View file

@ -5320,7 +5320,7 @@ DO
END IF
END IF
WriteBufLine MainTxtBuf, "if (new_error) goto exit_subfunc;"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto exit_subfunc;"
'statementn = statementn + 1
'if nochecks=0 then WriteBufLine MainTxtBuf, "S_" + str2$(statementn) + ":;"
@ -5773,7 +5773,7 @@ DO
vWatchAddLabel linenumber, 0
WriteBufLine MainTxtBuf, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_global_vars,(ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
WriteBufLine MainTxtBuf, "while((" + e$ + ")||new_error){"
WriteBufLine MainTxtBuf, "while((" + e$ + ")||is_error_pending()){"
ELSE
a$ = "WHILE ERROR! Expected expression after WHILE.": GOTO errmes
END IF
@ -5828,7 +5828,7 @@ DO
IF Error_Happened THEN GOTO errmes
IF stringprocessinghappened THEN e$ = cleanupstringprocessingcall$ + e$ + ")"
IF (typ AND ISSTRING) THEN a$ = "DO ERROR! Cannot accept a STRING type.": GOTO errmes
IF whileuntil = 1 THEN WriteBufLine MainTxtBuf, "while((" + e$ + ")||new_error){" ELSE WriteBufLine MainTxtBuf, "while((!(" + e$ + "))||new_error){"
IF whileuntil = 1 THEN WriteBufLine MainTxtBuf, "while((" + e$ + ")||is_error_pending()){" ELSE WriteBufLine MainTxtBuf, "while((!(" + e$ + "))||is_error_pending()){"
IF CheckingOn = 1 AND vWatchOn = 1 AND inclinenumber(inclevel) = 0 THEN
vWatchAddLabel linenumber, 0
WriteBufLine MainTxtBuf, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_global_vars,(ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
@ -5875,7 +5875,7 @@ DO
vWatchAddLabel linenumber, 0
WriteBufLine MainTxtBuf, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_global_vars,(ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
IF whileuntil = 1 THEN WriteBufLine MainTxtBuf, "}while((" + e$ + ")&&(!new_error));" ELSE WriteBufLine MainTxtBuf, "}while((!(" + e$ + "))&&(!new_error));"
IF whileuntil = 1 THEN WriteBufLine MainTxtBuf, "}while((" + e$ + ")&&(!is_error_pending()));" ELSE WriteBufLine MainTxtBuf, "}while((!(" + e$ + "))&&(!is_error_pending()));"
ELSE
WriteBufLine MainTxtBuf, "dl_continue_" + str2$(controlid(controllevel)) + ":;"
@ -6041,7 +6041,7 @@ DO
WriteBufLine MainTxtBuf, "fornext_step" + u$ + "=" + e$ + ";"
WriteBufLine MainTxtBuf, "if (fornext_step" + u$ + "<0) fornext_step_negative" + u$ + "=1; else fornext_step_negative" + u$ + "=0;"
WriteBufLine MainTxtBuf, "if (new_error) goto fornext_error" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto fornext_error" + u$ + ";"
WriteBufLine MainTxtBuf, "goto fornext_entrylabel" + u$ + ";"
WriteBufLine MainTxtBuf, "while(1){"
typbak = typ
@ -6199,9 +6199,9 @@ DO
END IF
IF stringprocessinghappened THEN
WriteBufLine MainTxtBuf, "if ((" + cleanupstringprocessingcall$ + e$ + "))||new_error){"
WriteBufLine MainTxtBuf, "if ((" + cleanupstringprocessingcall$ + e$ + "))||is_error_pending()){"
ELSE
WriteBufLine MainTxtBuf, "if ((" + e$ + ")||new_error){"
WriteBufLine MainTxtBuf, "if ((" + e$ + ")||is_error_pending()){"
END IF
IF iftype = 1 THEN l$ = l$ + sp + SCase$("Then") 'note: 'GOTO' will be added when iftype=2
@ -6674,9 +6674,9 @@ DO
NEXT
IF stringprocessinghappened THEN
WriteBufLine MainTxtBuf, "if ((" + cleanupstringprocessingcall$ + f12$ + "))||new_error){"
WriteBufLine MainTxtBuf, "if ((" + cleanupstringprocessingcall$ + f12$ + "))||is_error_pending()){"
ELSE
WriteBufLine MainTxtBuf, "if ((" + f12$ + ")||new_error){"
WriteBufLine MainTxtBuf, "if ((" + f12$ + ")||is_error_pending()){"
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
@ -7909,31 +7909,31 @@ DO
IF position$ = "1" THEN
IF useposition THEN l$ = l$ + sp2 + "," + sp + "1" + sp2 + ")" + sp + "=" ELSE l$ = l$ + sp2 + ")" + sp + "="
WriteBufLine MainTxtBuf, "tqbs=" + stringvariable$ + "; if (!new_error){"
WriteBufLine MainTxtBuf, "tqbs=" + stringvariable$ + "; if (!is_error_pending()){"
e$ = fixoperationorder$(expression$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
e$ = evaluatetotyp(e$, 32&)
IF Error_Happened THEN GOTO errmes
WriteBufLine MainTxtBuf, "tmp_long=" + e$ + "; if (!new_error){"
WriteBufLine MainTxtBuf, "tmp_long=" + e$ + "; if (!is_error_pending()){"
WriteBufLine MainTxtBuf, "if (tqbs->len){tqbs->chr[0]=tmp_long;}else{error(5);}"
WriteBufLine MainTxtBuf, "}}"
ELSE
WriteBufLine MainTxtBuf, "tqbs=" + stringvariable$ + "; if (!new_error){"
WriteBufLine MainTxtBuf, "tqbs=" + stringvariable$ + "; if (!is_error_pending()){"
e$ = fixoperationorder$(position$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$ + sp2 + ")" + sp + "="
e$ = evaluatetotyp(e$, 32&)
IF Error_Happened THEN GOTO errmes
WriteBufLine MainTxtBuf, "tmp_fileno=" + e$ + "; if (!new_error){"
WriteBufLine MainTxtBuf, "tmp_fileno=" + e$ + "; if (!is_error_pending()){"
e$ = fixoperationorder$(expression$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
e$ = evaluatetotyp(e$, 32&)
IF Error_Happened THEN GOTO errmes
WriteBufLine MainTxtBuf, "tmp_long=" + e$ + "; if (!new_error){"
WriteBufLine MainTxtBuf, "tmp_long=" + e$ + "; if (!is_error_pending()){"
WriteBufLine MainTxtBuf, "if ((tmp_fileno>0)&&(tmp_fileno<=tqbs->len)){tqbs->chr[tmp_fileno-1]=tmp_long;}else{error(5);}"
WriteBufLine MainTxtBuf, "}}}"
@ -10095,7 +10095,7 @@ DO
e$ = evaluatetotyp(e$, 64&)
IF Error_Happened THEN GOTO errmes
WriteBufLine MainTxtBuf, "tmp_fileno=" + e$ + ";"
WriteBufLine MainTxtBuf, "if (new_error) goto skip" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip" + u$ + ";"
i = i + 1
IF i > n THEN a$ = "Expected , ...": GOTO errmes
a3$ = ""
@ -10121,10 +10121,10 @@ DO
IF Error_Happened THEN GOTO errmes
IF lineinput THEN
WriteBufLine MainTxtBuf, "sub_file_line_input_string(tmp_fileno," + e$ + ");"
WriteBufLine MainTxtBuf, "if (new_error) goto skip" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip" + u$ + ";"
ELSE
WriteBufLine MainTxtBuf, "sub_file_input_string(tmp_fileno," + e$ + ");"
WriteBufLine MainTxtBuf, "if (new_error) goto skip" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip" + u$ + ";"
END IF
stringprocessinghappened = 1
ELSE
@ -10149,7 +10149,7 @@ DO
END IF
END IF
WriteBufLine MainTxtBuf, "if (new_error) goto skip" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip" + u$ + ";"
END IF
IF i = n THEN EXIT FOR
@ -22070,19 +22070,19 @@ SUB setrefer (a2$, typ2 AS LONG, e2$, method AS LONG)
r$ = "qbs_new_fixed(" + offset$ + "," + str2(id.tsize) + ",1)"
WriteBufLine MainTxtBuf, "tmp_long=" + a$ + ";"
IF method = 0 THEN
l$ = "if (!new_error) qbs_set(" + r$ + "," + evaluatetotyp(e$, typ) + ");"
l$ = "if (!is_error_pending()) qbs_set(" + r$ + "," + evaluatetotyp(e$, typ) + ");"
IF Error_Happened THEN EXIT SUB
ELSE
l$ = "if (!new_error) qbs_set(" + r$ + "," + e$ + ");"
l$ = "if (!is_error_pending()) qbs_set(" + r$ + "," + e$ + ");"
END IF
WriteBufLine MainTxtBuf, l$
ELSE
WriteBufLine MainTxtBuf, "tmp_long=" + a$ + ";"
IF method = 0 THEN
l$ = "if (!new_error) qbs_set( ((qbs*)(((uint64*)(" + n$ + "[0]))[tmp_long]))," + evaluatetotyp(e$, typ) + ");"
l$ = "if (!is_error_pending()) qbs_set( ((qbs*)(((uint64*)(" + n$ + "[0]))[tmp_long]))," + evaluatetotyp(e$, typ) + ");"
IF Error_Happened THEN EXIT SUB
ELSE
l$ = "if (!new_error) qbs_set( ((qbs*)(((uint64*)(" + n$ + "[0]))[tmp_long]))," + e$ + ");"
l$ = "if (!is_error_pending()) qbs_set( ((qbs*)(((uint64*)(" + n$ + "[0]))[tmp_long]))," + e$ + ");"
END IF
WriteBufLine MainTxtBuf, l$
END IF
@ -22098,10 +22098,10 @@ SUB setrefer (a2$, typ2 AS LONG, e2$, method AS LONG)
r$ = r$ + "(uint8*)(" + n$ + "[0])" + ",tmp_long,"
WriteBufLine MainTxtBuf, "tmp_long=" + a$ + ";"
IF method = 0 THEN
l$ = "if (!new_error) " + r$ + evaluatetotyp(e$, typ) + ");"
l$ = "if (!is_error_pending()) " + r$ + evaluatetotyp(e$, typ) + ");"
IF Error_Happened THEN EXIT SUB
ELSE
l$ = "if (!new_error) " + r$ + e$ + ");"
l$ = "if (!is_error_pending()) " + r$ + e$ + ");"
END IF
WriteBufLine MainTxtBuf, l$
tlayout$ = tl$
@ -22131,10 +22131,10 @@ SUB setrefer (a2$, typ2 AS LONG, e2$, method AS LONG)
IF t$ = "" THEN Give_Error "Cannot find C type to return array data": EXIT SUB
WriteBufLine MainTxtBuf, "tmp_long=" + a$ + ";"
IF method = 0 THEN
l$ = "if (!new_error) ((" + t$ + "*)(" + n$ + "[0]))[tmp_long]=" + evaluatetotyp(e$, typ) + ";"
l$ = "if (!is_error_pending()) ((" + t$ + "*)(" + n$ + "[0]))[tmp_long]=" + evaluatetotyp(e$, typ) + ";"
IF Error_Happened THEN EXIT SUB
ELSE
l$ = "if (!new_error) ((" + t$ + "*)(" + n$ + "[0]))[tmp_long]=" + e$ + ";"
l$ = "if (!is_error_pending()) ((" + t$ + "*)(" + n$ + "[0]))[tmp_long]=" + e$ + ";"
END IF
WriteBufLine MainTxtBuf, l$
@ -22397,7 +22397,7 @@ SUB xfileprint (a$, ca$, n)
e$ = evaluatetotyp(e$, 64&)
IF Error_Happened THEN EXIT SUB
WriteBufLine MainTxtBuf, "tab_fileno=tmp_fileno=" + e$ + ";"
WriteBufLine MainTxtBuf, "if (new_error) goto skip" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip" + u$ + ";"
i = i + 1
'PRINT USING? (file)
@ -22442,7 +22442,7 @@ SUB xfileprint (a$, ca$, n)
WriteBufLine DataTxtBuf, "qbs *" + puf$ + ";"
END IF
WriteBufLine MainTxtBuf, puf$ + "=qbs_new(0,0); qbs_set(" + puf$ + "," + puformat$ + ");"
WriteBufLine MainTxtBuf, "if (new_error) goto skip" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip" + u$ + ";"
'print expressions
b = 0
e$ = ""
@ -22471,7 +22471,7 @@ SUB xfileprint (a$, ca$, n)
WriteBufLine MainTxtBuf, "sub_file_print(tmp_fileno,tqbs,0,0,0);"
'-print e$
WriteBufLine MainTxtBuf, "qbs_set(tqbs," + e$ + ");"
WriteBufLine MainTxtBuf, "if (new_error) goto skip_pu" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip_pu" + u$ + ";"
WriteBufLine MainTxtBuf, "sub_file_print(tmp_fileno,tqbs,0,0,0);"
'-set length of tqbs to 0
WriteBufLine MainTxtBuf, "tqbs->len=0;"
@ -22496,7 +22496,7 @@ SUB xfileprint (a$, ca$, n)
END IF
END IF
END IF 'string/not string
WriteBufLine MainTxtBuf, "if (new_error) goto skip_pu" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip_pu" + u$ + ";"
e$ = ""
IF last THEN EXIT FOR
GOTO fprintunext
@ -22508,7 +22508,7 @@ SUB xfileprint (a$, ca$, n)
IF e$ <> "" THEN a2$ = "": last = 1: GOTO fprintulast
WriteBufLine MainTxtBuf, "skip_pu" + u$ + ":"
'check for errors
WriteBufLine MainTxtBuf, "if (new_error){"
WriteBufLine MainTxtBuf, "if (is_error_pending()){"
WriteBufLine MainTxtBuf, "g_tmp_long=new_error; new_error=0; sub_file_print(tmp_fileno,tqbs,0,0,0); new_error=g_tmp_long;"
WriteBufLine MainTxtBuf, "}else{"
IF a2$ = "," OR a2$ = ";" THEN nl = 0 ELSE nl = 1 'note: a2$ is set to the last element of a$
@ -22576,7 +22576,7 @@ SUB xfileprint (a$, ca$, n)
END IF
IF usetab THEN WriteBufLine MainTxtBuf, "sub_file_print(tmp_fileno,nothingstring,0,1,0);"
END IF 'len(e$)
WriteBufLine MainTxtBuf, "if (new_error) goto skip" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip" + u$ + ";"
e$ = ""
IF gotofpu THEN GOTO fpujump
@ -22620,7 +22620,7 @@ SUB xfilewrite (ca$, n)
e$ = evaluatetotyp(e$, 64&)
IF Error_Happened THEN EXIT SUB
WriteBufLine MainTxtBuf, "tab_fileno=tmp_fileno=" + e$ + ";"
WriteBufLine MainTxtBuf, "if (new_error) goto skip" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip" + u$ + ";"
i = i + 1
IF i > n THEN
WriteBufLine MainTxtBuf, "sub_file_print(tmp_fileno,nothingstring,0,0,1);"
@ -22665,7 +22665,7 @@ SUB xfilewrite (ca$, n)
IF Error_Happened THEN EXIT SUB
'format: string, (1/0) extraspace, (1/0) tab, (1/0)begin a new line
WriteBufLine MainTxtBuf, "sub_file_print(tmp_fileno," + e$ + ",0,0," + STR$(newline) + ");"
WriteBufLine MainTxtBuf, "if (new_error) goto skip" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip" + u$ + ";"
e$ = ""
IF last THEN EXIT FOR
GOTO writefilenext
@ -22877,7 +22877,7 @@ SUB xprint (a$, ca$, n)
WriteBufLine DataTxtBuf, "qbs *" + puf$ + ";"
END IF
WriteBufLine MainTxtBuf, puf$ + "=qbs_new(0,0); qbs_set(" + puf$ + "," + puformat$ + ");"
WriteBufLine MainTxtBuf, "if (new_error) goto skip_pu" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip_pu" + u$ + ";"
'print expressions
b = 0
@ -22907,7 +22907,7 @@ SUB xprint (a$, ca$, n)
WriteBufLine MainTxtBuf, "qbs_" + lp$ + "print(tqbs,0);"
'-print e$
WriteBufLine MainTxtBuf, "qbs_set(tqbs," + e$ + ");"
WriteBufLine MainTxtBuf, "if (new_error) goto skip_pu" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip_pu" + u$ + ";"
IF lp THEN WriteBufLine MainTxtBuf, "lprint_makefit(tqbs);" ELSE WriteBufLine MainTxtBuf, "makefit(tqbs);"
WriteBufLine MainTxtBuf, "qbs_" + lp$ + "print(tqbs,0);"
'-set length of tqbs to 0
@ -22935,7 +22935,7 @@ SUB xprint (a$, ca$, n)
END IF
END IF
END IF 'string/not string
WriteBufLine MainTxtBuf, "if (new_error) goto skip_pu" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip_pu" + u$ + ";"
e$ = ""
IF last THEN EXIT FOR
GOTO printunext
@ -22947,7 +22947,7 @@ SUB xprint (a$, ca$, n)
IF e$ <> "" THEN a2$ = "": last = 1: GOTO printulast
WriteBufLine MainTxtBuf, "skip_pu" + u$ + ":"
'check for errors
WriteBufLine MainTxtBuf, "if (new_error){"
WriteBufLine MainTxtBuf, "if (is_error_pending()){"
WriteBufLine MainTxtBuf, "g_tmp_long=new_error; new_error=0; qbs_" + lp$ + "print(tqbs,0); new_error=g_tmp_long;"
WriteBufLine MainTxtBuf, "}else{"
IF a2$ = "," OR a2$ = ";" THEN nl = 0 ELSE nl = 1 'note: a2$ is set to the last element of a$
@ -23001,7 +23001,7 @@ SUB xprint (a$, ca$, n)
IF (typ AND ISREFERENCE) THEN e$ = refer(e$, typ, 0)
IF Error_Happened THEN EXIT SUB
WriteBufLine MainTxtBuf, "qbs_set(tqbs," + e$ + ");"
WriteBufLine MainTxtBuf, "if (new_error) goto skip" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip" + u$ + ";"
IF lp THEN WriteBufLine MainTxtBuf, "lprint_makefit(tqbs);" ELSE WriteBufLine MainTxtBuf, "makefit(tqbs);"
WriteBufLine MainTxtBuf, "qbs_" + lp$ + "print(tqbs,0);"
ELSE
@ -23142,7 +23142,7 @@ SUB xwrite (ca$, n)
IF Error_Happened THEN EXIT SUB
'format: string, (1/0) extraspace, (1/0) tab, (1/0)begin a new line
WriteBufLine MainTxtBuf, "qbs_print(" + e$ + "," + STR$(newline) + ");"
WriteBufLine MainTxtBuf, "if (new_error) goto skip" + u$ + ";"
WriteBufLine MainTxtBuf, "if (is_error_pending()) goto skip" + u$ + ";"
e$ = ""
IF last THEN EXIT FOR
GOTO writenext