Posts: 22
Threads: 1
Joined: Jul 2022
Reputation:
0
As part of Project Manhattan, I am doing a port of the QB64 runtime as well as doing some kernel work.
Posts: 224
Threads: 7
Joined: Apr 2022
Reputation:
14
post the cloth simulator!
Posts: 22
Threads: 1
Joined: Jul 2022
Reputation:
0
Posts: 22
Threads: 1
Joined: Jul 2022
Reputation:
0
qb64.bi updates
Code: (Select All) #define ptrszint int64
#define uptrszint uint64
#define ptrsz 8
' QB64 string descriptor structure
type qbs_field
as int32 fileno
as int64 fileid
as int64 size
as int64 offset
end type
type qbs
as uint8 ptr chr ' a 32 bit pointer to the string's data
as int32 len ' must be signed for comparisons against signed int32s
as uint8 in_mem64 ' set to 1 if in the conventional memory DBLOCK
as uint16 ptr mem64_descriptor
as uint16 mem64_descriptor_offset
as uint32 listi ' the index in the list of strings that references it
as uint8 tmp ' set to 1 if the string can be deleted immediately after being processed
as uint32 tmplisti ' the index in the list of strings that references it
as uint8 fixed ' fixed length string
as uint8 readonly ' set to 1 if string is read only
as qbs_field ptr field
end type
type img_struct
as any ptr lock_offset
as int64 lock_id
as uint8 valid ' 0,1 0=invalid
as uint8 text ' if set, surface is a text surface
as uint8 console ' dummy surface to absorb unimplemented console functionality
as uint16 width
as uint16 height
as uint8 bytes_per_pixel ' 1,2,4
as uint8 bits_per_pixel ' 1,2,4,8,16(text),32
as uint32 mask ' 1,3,&HF,&HFF,&HFFFF,&HFFFFFFFF
as uint16 compatible_mode ' 0,1,2,7,8,9,10,11,12,13,32,256
as uint32 color
as uint32 background_color
as uint32 draw_color
as uint32 font ' 8,14,16,?
as int16 top_row ' VIEW PRINT settings, unique (as in QB) to each "page"
as int16 bottom_row ' unique (as in QB) to each "page"
as int16 cursor_x
as int16 cursor_y
as uint8 cursor_show
as uint8 cursor_firstvalue
as uint8 cursor_lastvalue
union
as uint8 ptr offset
as uint32 ptr offset32
end union
as uint32 flags
as uint32 ptr pal
as int32 transparent_color '-1 means no color is transparent
as uint8 alpha_disabled
as uint8 holding_cursor
as uint8 print_mode
' BEGIN apm ('active page migration')
' everything between apm points is migrated during active page changes
' note: apm data is only relevent to graphics modes
as uint8 apm_p1
as int32 view_x1
as int32 view_y1
as int32 view_x2
as int32 view_y2
as int32 view_offset_x
as int32 view_offset_y
as float x
as float y
as uint8 clipping_or_scaling
as float scaling_x
as float scaling_y
as float scaling_offset_x
as float scaling_offset_y
as float window_x1
as float window_y1
as float window_x2
as float window_y2
as float draw_ta
as float draw_scale
as uint8 apm_p2
' END apm
end type
' img_struct flags
#define IMG_FREEPAL 1 ' free palette data before freeing image
#define IMG_SCREEN 2 ' img is linked to other screen pages
#define IMG_FREEMEM 4 ' if set, it means memory must be freed
' QB64 internal variable type flags (internally referenced by some functions)
#define ISSTRING 1073741824
#define ISFLOAT 536870912
#define ISUNSIGNED 268435456
#define ISPOINTER 134217728
#define ISFIXEDLENGTH 67108864 ' only set for strings with pointer flag
#define ISINCONVENTIONALMEMORY 33554432
#define ISOFFSETINBITS 16777216
type ontimer_struct
as uint8 allocated
as uint32 id ' the event ID to trigger (0=no event)
as int64 pass ' the value to pass to the triggered event (only applicable to ON ... CALL ...(x)
as uint8 active ' 0=OFF, 1=ON, 2=STOP
as uint8 state ' 0=untriggered,1=triggered
as float seconds ' how many seconds between events
as float last_time ' the last time this event was triggered
end type
type onkey_struct
as uint32 id ' the event ID to trigger (0=no event)
as int64 pass ' the value to pass to the triggered event (only applicable to ON ... CALL ...(x)
as uint8 active ' 0=OFF, 1=ON, 2=STOP
as uint8 state ' 0=untriggered,1=triggered,2=in progress(TIMER only),2+=multiple events queued(KEY only)
as uint32 keycode ' 32-bit code, same as what _KEYHIT returns
as uint32 keycode_alternate ' an alternate keycode which may also trigger event
as uint8 key_scancode
as uint8 key_flags
' flags:
' 0 No keyboard flag, 1-3 Either Shift key, 4 Ctrl key, 8 Alt key,32 NumLock key,64 Caps Lock key, 128 Extended keys on a 101-key keyboard
' To specify multiple shift states, add the values together. For example, a value of 12 specifies that the user-defined key is used in combination with the
' Ctrl and Alt keys.
as qbs ptr text
end type
type onstrig_struct
as uint32 id ' the event ID to trigger (0=no event)
as int64 pass ' the value to pass to the triggered event (only applicable to ON ... CALL ...(x)
as uint8 active ' 0=OFF, 1=ON, 2=STOP
as uint8 state ' 0=untriggered,1=triggered,2=in progress(TIMER only),2+=multiple events queued(KEY only)
end type
type byte_element_struct
as uint64 offset
as int32 length
end type
type device_struct
as int32 used
as int32 type
' 0=Unallocated
' 1=Joystick/Gamepad
' 2=Keybaord
' 3=Mouse
as char ptr name
as int32 connected
as int32 lastbutton
as int32 lastaxis
as int32 lastwheel
'--------------
as int32 max_events
as int32 queued_events
as uint8 ptr events ' the structure and size of the events depends greatly on the device and its capabilities
as int32 event_size
'--------------
dim as uint8 STRIG_button_pressed(256) ' checked and cleared by the STRIG function
'--------------
as any ptr handle_pointer ' handle as pointer
as int64 handle_int ' handle as integer
as char ptr description ' description provided by manufacturer
as int64 product_id
as int64 vendor_id
as int32 buttons
as int32 axes
as int32 balls
as int32 hats
end type
' device_struct constants
#define QUEUED_EVENTS_LIMIT 1024
#define DEVICETYPE_CONTROLLER 1
#define DEVICETYPE_KEYBOARD 2
#define DEVICETYPE_MOUSE 3
type mem_block
as ptrszint offset
as ptrszint size
as int64 lock_id ' 64-bit key, must be present at lock's offset or memory region is invalid
as ptrszint lock_offset ' pointer to lock
as ptrszint type
/'
memorytype (4 bytes, but only the first used, for flags):
1 integer values
2 unsigned (set in conjunction with integer)
4 floating point values
8 char string(s) 'element-size is the memory size of 1 string
'/
as ptrszint elementsize
as int32 image
as int32 sound
end type
type mem_lock
as uint64 id
as 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 ----
as any ptr offset ' used by malloc'ed blocks to free them
end type
static shared as uint32 new_error = 0
static shared as uint32 error_err = 0
static shared as float error_erl = 0
static shared as uint32 error_occurred = 0
static shared as uint32 error_goto_line = 0
static shared as uint32 error_handling = 0
static shared as uint32 error_retry = 0
' keyhit cyclic buffer
static shared as int64 keyhit(8192)
' keyhit specific internal flags: (stored in high 32-bits)
' &4294967296->numpad was used
static shared as int32 keyhit_nextfree
static shared as int32 keyhit_next
' note: if full, the oldest message is discarded to make way for the new message
static shared as uint8 port60h_event(256)
static shared as int32 port60h_events
static shared as int32 window_exists
static shared as int32 no_control_characters2
static shared as int32 disableEvents = 0
' shared global variables
static shared as int32 consolekey
static shared as int32 consolemousex
static shared as int32 consolemousey
static shared as int32 consolebutton
static shared as int32 sleep_break
static shared as uint64 mem_lock_id
static shared as mem_lock ptr mem_lock_tmp
static shared as int64 exit_code
static shared as int32 lock_mainloop ' 0=unlocked, 1=lock requested, 2=locked
static shared as int64 device_event_index
static shared as int32 exit_ok
static shared as qbs ptr func_command_str
static shared as int32 timer_event_occurred = 0 ' inc/dec as each GOSUB to QBMAIN ()
' begins/ends
static shared as int32 timer_event_id = 0
static shared as int32 key_event_occurred = 0 ' inc/dec as each GOSUB to QBMAIN () begins/ends
static shared as int32 key_event_id = 0
static shared as int32 strig_event_occurred = 0 ' inc/dec as each GOSUB to QBMAIN ()
' begins/ends
static shared as int32 strig_event_id = 0
static shared as uint32 ercl
static shared as uint32 inclercl
static shared as char ptr includedfilename
static shared as uint16 call_absolute_offsets(256)
static shared as uint32 dbgline
static shared as uint32 qbs_mem64_sp = 256
static shared as uint32 mem64_sp = 65536
static shared as ptrszint dblock ' 32bit offset of dblock
static shared as uint8 close_program = 0
static shared as int32 tab_spc_cr_size = 1 ' 1=PRINT(default), 2=FILE
static shared as int32 tab_fileno = 0 ' only valid if tab_spc_cr_size=2
static shared as int32 tab_LPRINT = 0 ' 1=dest is LPRINT image
static shared as uint64 ptr nothingvalue ' a pointer to 8 empty bytes in dblock
static shared as uint32 qbs_tmp_list_nexti = 1
static shared as uint32 bkp_new_error = 0
static shared as qbs ptr nothingstring
static shared as uint32 qbevent = 0
static shared as uint8 suspend_program = 0
static shared as uint8 stop_program = 0
static shared as SYSTEM_TYPE ptr mem64_static_pointer = @mem64(0) + 1280 + 65536
static shared as SYSTEM_TYPE ptr mem64_dynamic_base = @mem64(0) + 655360
static shared as SYSTEM_TYPE ptr mem_static
static shared as SYSTEM_TYPE ptr mem_static_pointer
static shared as SYSTEM_TYPE ptr mem_static_limit
static shared as float last_line = 0
static shared as uint32 next_return_point = 0
static shared as uint32 ptr return_point = 0: return_point = peek(uint32 ptr,malloc(4 * 16384))
static shared as uint32 return_points = 16384
static shared as any ptr qbs_input_variableoffsets(257)
static shared as int32 qbs_input_variabletypes(257)
' qbmain specific global variables
static shared as char g_tmp_char
static shared as uint8 g_tmp_uchar
static shared as int16 g_tmp_short
static shared as uint16 g_tmp_ushort
static shared as int32 g_tmp_long
static shared as uint32 g_tmp_ulong
static shared as int8 g_tmp_int8
static shared as uint8 g_tmp_uint8
static shared as int16 g_tmp_int16
static shared as uint16 g_tmp_uint16
static shared as int32 g_tmp_int32
static shared as uint32 g_tmp_uint32
static shared as int64 g_tmp_int64
static shared as uint64 g_tmp_uint64
static shared as float g_tmp_float
static shared as float g_tmp_double
static shared as float g_tmp_longdouble
static shared as qbs ptr g_tmp_str
static shared as qbs ptr g_swap_str
static shared as qbs ptr pass_str
static shared as ptrszint data_offset = 0
Posts: 22
Threads: 1
Joined: Jul 2022
Reputation:
0
bit-array access functions
Code: (Select All) ' bit-array access functions (note: used to be included through 'bit.cpp')
proc SYSTEM_BUS_T.getubits(bsize as uint32, _base as uint8 ptr, i as ptrszint) as uint64
static as int64 bmask, n=1
bmask = not (-((peek(int64,@n))) shl bsize)
i *= bsize
return ((*cptr(uint64 ptr,(_base + (i shr 3)))) shr (i and 7)) and bmask
end proc
proc SYSTEM_BUS_T.getbits(bsize as uint32, _base as uint8 ptr, i as ptrszint) as int64
static as int64 bmask, bval64, n=1
bmask = not (-((peek(int64,@n)) shl bsize))
i *= bsize
bval64 = ((*cptr(uint64 ptr,(_base + (i shr 3))) shr (i and 7))) and bmask
if (bval64 and ((peek(int64,@n)) shl (bsize - 1))) then
return bval64 or (not bmask)
end if
return bval64
end proc
def SYSTEM_BUS_T.setbits(bsize as uint32, _base as uint8 ptr, i as ptrszint, _val as int64)
static as int64 bmask,n=1
static as uint64 ptr bptr64
bmask = ((peek(uint64,@n)) shl bsize) - 1
i *= bsize
bptr64 = peek(uint64 ptr,(_base + (i shr 3)))
*bptr64 = (*cptr(uint64 ptr,bptr64) and (((bmask shl (i and 7)) xor -1))) or ((_val and bmask) shl (i and 7))
end def
Posts: 1,510
Threads: 53
Joined: Jul 2022
Reputation:
47
"QB64 runtime"? Stupid question: is this going to be set up more or less like M$QB, ie. BRUN45.EXE? This would be a good idea to have like 20 or more programs in a single directory with the runtime module and the data (configuration, images, CSV files etc.) they require. Since people keep complaining about the EXE sizes created by QB64 even on 64-bit. I'm sorry if I misunderstand.
Very clever of the OP to port stuff from Python and even using the same keyword in particular.
Posts: 22
Threads: 1
Joined: Jul 2022
Reputation:
0
(07-20-2022, 10:07 PM)dbox Wrote: What is all this?
(07-27-2022, 10:08 PM)mnrvovrfc Wrote: "QB64 runtime"? Stupid question: is this going to be set up more or less like M$QB, ie. BRUN45.EXE? This would be a good idea to have like 20 or more programs in a single directory with the runtime module and the data (configuration, images, CSV files etc.) they require. Since people keep complaining about the EXE sizes created by QB64 even on 64-bit. I'm sorry if I misunderstand.
Very clever of the OP to port stuff from Python and even using the same keyword in particular.
It will be more like QB.LIB.
Posts: 224
Threads: 7
Joined: Apr 2022
Reputation:
14
(07-21-2022, 06:46 PM)fatman2021 Wrote: One cloth simulation:
https://github.com/fatman2021/Simulation...i.tar.lzma
That's not a simulator, that's a video. Show us the solution CGI source code for the challenge you put out
Posts: 22
Threads: 1
Joined: Jul 2022
Reputation:
0
Posts: 22
Threads: 1
Joined: Jul 2022
Reputation:
0
07-28-2022, 04:04 PM
(This post was last modified: 07-28-2022, 04:05 PM by fatman2021.)
Updated floating point math support:
Code: (Select All) ' float128 math functions
/'
void float128_from_double(float128* a, double* b) {
*a = (float128)(*(double*)(b));
}
'/
def SYSTEM_BUS_T.k_float128_from_double(a as FLOAT128 ptr, b as float ptr)
*a = *b
end def
/'
void float128_to_double(float128* a, double* b) {
*a = (double)(*(float128*)(b));
}
'/
def SYSTEM_BUS_T.k_float128_to_double(a as FLOAT128 ptr, b as float ptr)
*b = *a
end def
/'
void float128_add(float128* a, float128* b, float128* c) {
*c = *a + *b;
}
'/
def SYSTEM_BUS_T.k_float128_add(a as FLOAT128 ptr, b as FLOAT128 ptr, c as FLOAT128 ptr)
*c = *a + *b
end def
/'
void float128_sub(float128* a, float128* b, float128* c) {
*c = *a - *b;
}
'/
def SYSTEM_BUS_T.k_float128_sub(a as FLOAT128 ptr, b as FLOAT128 ptr, c as FLOAT128 ptr)
*c = *a - *b
end def
/'
void float128_abs(float128* a, float128* b) {
if (*a > 0) {
*b = *a;
} else {
*b = -*a;
}
}
'/
def SYSTEM_BUS_T.k_float128_abs(a as FLOAT128 ptr, b as FLOAT128 ptr)
if (*a > 0) then
*b = *a
else
*b = -*a
end if
end def
/'
void float128_mul(float128* a, float128* b, float128* c) {
*c = *a * *b;
}
'/
def SYSTEM_BUS_T.k_float128_mul(a as FLOAT128 ptr, b as FLOAT128 ptr, c as FLOAT128 ptr)
*c = *a * *b
end def
/'
void float128_div(float128* a, float128* b, float128* c) {
*c = *a / *b;
}
'/
def SYSTEM_BUS_T.k_float128_div(a as FLOAT128 ptr, b as FLOAT128 ptr, c as FLOAT128 ptr)
*c = *a / *b
end def
/'
int float128_cmp(float128* a, float128* b) {
if (*a > *b) {
return 1;
} else if (*a < *b) {
return -1;
} else {
return 0;
}
}
'/
proc SYSTEM_BUS_T.k_float128_cmp(a as FLOAT128 ptr, b as FLOAT128 ptr) as int_t
if (*a > *b) then
return 1
elseif (*a < *b) then
return -1
else
return 0
endif
end proc
' float256 math functions
/'
void float256_from_double(float256* a, double* b) {
*a = (float256)(*(double*)(b));
}
'/
def SYSTEM_BUS_T.k_float256_from_double(a as FLOAT256 ptr, b as float ptr)
*a = *b
end def
/'
void float256_to_double(float256* a, double* b) {
*a = (double)(*(float256*)(b));
}
'/
def SYSTEM_BUS_T.k_float256_to_double(a as FLOAT256 ptr, b as float ptr)
*b = *a
end def
/'
void float256_add(float256* a, float256* b, float256* c) {
*c = *a + *b;
}
'/
def SYSTEM_BUS_T.k_float256_add(a as FLOAT256 ptr, b as FLOAT256 ptr, c as FLOAT256 ptr)
*c = *a + *b
end def
/'
void float256_sub(float256* a, float256* b, float256* c) {
*c = *a - *b;
}
'/
def SYSTEM_BUS_T.k_float256_sub(a as FLOAT256 ptr, b as FLOAT256 ptr, c as FLOAT256 ptr)
*c = *a - *b
end def
/'
void float256_abs(float256* a, float256* b) {
if (*a > 0) {
*b = *a;
} else {
*b = -*a;
}
}
'/
def SYSTEM_BUS_T.k_float256_abs(a as FLOAT256 ptr, b as FLOAT256 ptr)
if (*a > 0) then
*b = *a
else
*b = -*a
end if
end def
/'
void float256_mul(float256* a, float256* b, float256* c) {
*c = *a * *b;
}
'/
def SYSTEM_BUS_T.k_float256_mul(a as FLOAT256 ptr, b as FLOAT256 ptr, c as FLOAT256 ptr)
*c = *a * *b
end def
/'
void float256_div(float256* a, float256* b, float256* c) {
*c = *a / *b;
}
'/
def SYSTEM_BUS_T.k_float256_div(a as FLOAT256 ptr, b as FLOAT256 ptr, c as FLOAT256 ptr)
*c = *a / *b
end def
/'
int float256_cmp(float256* a, float256* b) {
if (*a > *b) {
return 1;
} else if (*a < *b) {
return -1;
} else {
return 0;
}
}
'/
proc SYSTEM_BUS_T.k_float256_cmp(a as FLOAT256 ptr, b as FLOAT256 ptr) as int_t
if (*a > *b) then
return 1
elseif (*a < *b) then
return -1
else
return 0
endif
end proc
' float512 math functions
/'
void float512_from_double(float512* a, double* b) {
*a = (float512)(*(double*)(b));
}
'/
def SYSTEM_BUS_T.k_float512_from_double(a as FLOAT512 ptr, b as float ptr)
*a = *b
end def
/'
void float512_to_double(float512* a, double* b) {
*a = (double)(*(float512*)(b));
}
'/
def SYSTEM_BUS_T.k_float512_to_double(a as FLOAT512 ptr, b as float ptr)
*b = *a
end def
/'
void float512_add(float512* a, float512* b, float512* c) {
*c = *a + *b;
}
'/
def SYSTEM_BUS_T.k_float512_add(a as FLOAT512 ptr, b as FLOAT512 ptr, c as FLOAT512 ptr)
*c = *a + *b
end def
/'
void float512_sub(float512* a, float512* b, float512* c) {
*c = *a - *b;
}
'/
def SYSTEM_BUS_T.k_float512_sub(a as FLOAT512 ptr, b as FLOAT512 ptr, c as FLOAT512 ptr)
*c = *a - *b
end def
/'
void float512_abs(float512* a, float512* b) {
if (*a > 0) {
*b = *a;
} else {
*b = -*a;
}
}
'/
def SYSTEM_BUS_T.k_float512_abs(a as FLOAT512 ptr, b as FLOAT512 ptr)
if (*a > 0) then
*b = *a
else
*b = -*a
end if
end def
/'
void float512_mul(float512* a, float512* b, float512* c) {
*c = *a * *b;
}
'/
def SYSTEM_BUS_T.k_float512_mul(a as FLOAT512 ptr, b as FLOAT512 ptr, c as FLOAT512 ptr)
*c = *a * *b
end def
/'
void float512_div(float512* a, float512* b, float512* c) {
*c = *a / *b;
}
'/
def SYSTEM_BUS_T.k_float512_div(a as FLOAT512 ptr, b as FLOAT512 ptr, c as FLOAT512 ptr)
*c = *a / *b
end def
/'
int float512_cmp(float512* a, float512* b) {
if (*a > *b) {
return 1;
} else if (*a < *b) {
return -1;
} else {
return 0;
}
}
'/
proc SYSTEM_BUS_T.k_float512_cmp(a as FLOAT512 ptr, b as FLOAT512 ptr) as int_t
if (*a > *b) then
return 1
elseif (*a < *b) then
return -1
else
return 0
endif
end proc
|
