+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: Chatting and Socializing (https://qb64phoenix.com/forum/forumdisplay.php?fid=11)
+--- Forum: General Discussion (https://qb64phoenix.com/forum/forumdisplay.php?fid=2)
+--- Thread: It's verification time!!! (/showthread.php?tid=593)
RE: It's verification time!!! - fatman2021 - 07-09-2022
The next challenger is the Dynamic Memory Manager:
Code: (Select All)
' mem64_FAR_DYNAMIC memory manager
/'
(uses a custom "links" based memory manager)
'/
' &HA000 DBLOCK SIZE DBLOCK OFFSET
' 655360 - (65536 + 1280 )=588544 links possible
' links limited to 588544/4=147136 (do not have enough links if avg. block size less than 4 bytes)
' stores blocks, not free memory, because blocks are easier to identify
' always scanned from beginning to end, so prev. pointer is unnecessary
proc SYSTEM_BUS_T.mem64_dynamic_malloc(size as uinteger) as SYSTEM_TYPE ptr
static as integer i
static as SYSTEM_TYPE ptr top
static as mem64_dynamic_link_type ptr link
static as mem64_dynamic_link_type ptr newlink
static as mem64_dynamic_link_type ptr prev_link
if (size > 65536) then
error(505) '>64K
end if
' to avoid mismatches between offsets, all 0-byte blocks are given the special offset A000h (the top of the heap)
if (size) then
' forces blocks to be multiples of 16 bytes so they align with segment boundaries
if (size and 15) then
size = size - (size and 15) + 16
end if
else
return (@mem64(0) + 655360) ' top of heap
end if
' is a space large enough between existing blocks available?
' (if not, memory will be allocated at bottom of heap)
top = @mem64(0) + 655360 ' top is the base of the higher block
prev_link = 0
if (link = mem64_dynamic_link_first) then
mem64_dynamic_findspace:
if ((top - link->top) >= size) then ' gpf
' found free space
goto mem64_dynamic_make_new_link
end if
prev_link = link
top = link->offset ' set top to the base of current block for future comparisons
if (link = link->next_ptr) then
goto mem64_dynamic_findspace
end if
end if
' no space between existing blocks is large enough, alloc below 'top'
if ((top - mem64_static_pointer) < size) then
error(506) ' a large enough block cannot be created!
end if
mem64_dynamic_base = top - size
' get a new link index
mem64_dynamic_make_new_link:
if (mem64_dynamic_free_link) then
mem64_dynamic_free_link = mem64_dynamic_free_link - 1
i = mem64_dynamic_free_list(mem64_dynamic_free_link)
else
mem64_dynamic_next_link = mem64_dynamic_next_link + 1
i = mem64_dynamic_next_link
if (i >= 147136) then
error(507) ' not enough blocks
end if
end if
newlink = peek(mem64_dynamic_link_type ptr,@mem64_dynamic_link(i))
' set link info
newlink->i = i
newlink->offset = top - size
newlink->size = size
newlink->top = top
' attach below prev_link
if (prev_link) then
newlink->next_ptr = prev_link->next_ptr ' NULL if none
prev_link->next_ptr = newlink
else
newlink->next_ptr = mem64_dynamic_link_first ' NULL if none
mem64_dynamic_link_first = newlink'
end if
return newlink->offset
end proc
def SYSTEM_BUS_T.mem64_dynamic_free(block as SYSTEM_TYPE ptr)
static as mem64_dynamic_link_type ptr link
static as mem64_dynamic_link_type ptr prev_link
if (mem64_dynamic_link_first) then
if (block) then
if (block = (@mem64(0) + 655360)) then
return ' to avoid mismatches between offsets, all 0-byte blocks are given the special offset A000h
' (the top of the heap)
end if
else
return
end if
else
return
end if
prev_link = 0
link = mem64_dynamic_link_first
check_next:
if (link->offset = block) then
' unlink
if (prev_link) then
prev_link->next_ptr = link->next_ptr
else
mem64_dynamic_link_first = link->next_ptr
end if
' free link
mem64_dynamic_free_link = mem64_dynamic_free_link + 1
mem64_dynamic_free_list(mem64_dynamic_free_link) = link->i
' memory freed successfully!
return
end if
prev_link = link
if (link = link->next_ptr) then
goto check_next
end if
return
end def
def SYSTEM_BUS_T.sub_defseg(segment as integer, passed as integer)
if (new_error) then
return
end if
if (passed) then
if ((segment < -65536) or (segment > 65535)) then ' same range as QB checks
error(6)
else
defseg = @mem64(0) + (peek(ushort,segment)) * 16
end if
else
defseg = @mem64(1280)
return
end if
end def
proc SYSTEM_BUS_T.func_peek(offset as integer) as integer
if ((offset < -65536) or (offset > 65535)) then ' same range as QB checks
error(6)
return 0
end if
return defseg[peek(ushort,@offset)]
'return defseg[(uint16)offset];
end proc
def SYSTEM_BUS_T.sub_poke(offset as integer, value as integer)
if (new_error) then
return
end if
if ((offset < -65536) or (offset > 65535)) then ' // same range as QB checks
error(6)
return
end if
defseg[peek(ushort,@offset)] = value
end def
def SYSTEM_BUS_T.more_return_points()
if (return_points > 2147483647) then
error(256)
end if
return_points *= 2
return_point = peek(uinteger ptr,realloc(return_point, return_points * 4))
if (return_point = 0) then
error(256)
end if
end def
proc SYSTEM_BUS_T.qbs_new_descriptor() as qbs ptr
' MLP //qbshlp1++;
if (qbs_malloc_freed_num) then
/' MLP
static as qbs ptr s
s=(qbs*)memset((void *)qbs_malloc_freed[--qbs_malloc_freed_num],0,sizeof(qbs));
s->dbgl=dbgline;
return s;
'/
qbs_malloc_freed_num -= 1
return memset(@qbs_malloc_freed[qbs_malloc_freed_num], 0, sizeof(qbs))
end if
if (qbs_malloc_next = 65536) then
qbs_malloc = calloc(sizeof(qbs) * 65536, 1) ' ~1MEG
qbs_malloc_next = 0
end if
/' 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;
'/
qbs_malloc_next += 1
return @qbs_malloc[qbs_malloc_next]
end proc
def SYSTEM_BUS_T.qbs_free_descriptor(str_data as qbs ptr)
' MLP //qbshlp1--;
if (qbs_malloc_freed_num = qbs_malloc_freed_size) then
qbs_malloc_freed_size *= 2
qbs_malloc_freed = realloc(qbs_malloc_freed, qbs_malloc_freed_size * ptrsz)
if (qbs_malloc_freed) then
else
error(508)
end if
end if
qbs_malloc_freed[qbs_malloc_freed_num] = cast(ptrszint,str_data)
qbs_malloc_freed_num += 1
return
end defRE: It's verification time!!! - fatman2021 - 07-10-2022
Next up is I/O emulation:
Code: (Select All)
def SYSTEM_BUS_T.sub__blink(onoff as integer)
if (onoff = 1) then
H3C0_blink_enable = 1
else
H3C0_blink_enable = 0
end if
end def
proc SYSTEM_BUS_T.func__blink() as integer
return -H3C0_blink_enable
end proc
def SYSTEM_BUS_T.sub_out(port as integer, data_out as integer)
if (new_error) then
return
end if
unsupported_port_accessed = 0
port = port and 65535
data_out = data_out and 255
if (port = &H3C0) then
H3C0_blink_enable = data_out and (1 shl 3)
goto done
end if
if (port = &H3C7) then '&H3C7, set palette register read index
H3C7_palette_register_read_index = data_out
H3C9_read_next = 0
goto done
end if
if (port = &H3C8) then '&H3C8, set palette register write index
H3C8_palette_register_index = data_out
H3C9_next = 0
goto done
end if
' alpha =$C005(49157)
' red =$C002(49154)
' green =$C003(49155)
' blue =$C003(49156)
' fg_color =$C0C9(49353)
' bg_color =$C0CA(49354)
if (port = &H3C9) then ' &H3C9, set palette color
data_out = data_out and 63
if (write_page->pal) then ' avoid NULL pointer
if (H3C9_next = 0) then ' red
write_page->pal[H3C8_palette_register_index] = &HFF00FFFF _
and write_page->pal[H3C8_palette_register_index]
write_page->pal[H3C8_palette_register_index] += _
(qbr(cast(double,data_out * 4.063492d - 0.4999999d)) shl 16)
computer.cpu_mos6510->mem->poke64(49154,data_out)
end if
if (H3C9_next = 1) then ' green
write_page->pal[H3C8_palette_register_index] = &HFF00FFFF _
and write_page->pal[H3C8_palette_register_index]
write_page->pal[H3C8_palette_register_index] += _
(qbr(cast(double,data_out * 4.063492d - 0.4999999d)) shl 8)
computer.cpu_mos6510->mem->poke64(49155,data_out)
end if
if (H3C9_next = 2) then ' blue
write_page->pal[H3C8_palette_register_index] = &HFF00FFFF _
and write_page->pal[H3C8_palette_register_index]
write_page->pal[H3C8_palette_register_index] += _
(qbr(cast(double,data_out * 4.063492d - 0.4999999d)))
computer.cpu_mos6510->mem->poke64(49156,data_out)
end if
end if
H3C9_next = H3C9_next + 1
if (H3C9_next = 3) then
H3C9_next = 0
H3C8_palette_register_index = H3C8_palette_register_index + 1
H3C8_palette_register_index = &HFF and H3C8_palette_register_index
end if
goto done
end if
unsupported_port_accessed = 1
done:
return
error_ret:
error(5)
end def
proc SYSTEM_BUS_T.func_inp(port as integer) as integer
static as integer value
unsupported_port_accessed = 0
if ((port > 65535) or (port < -65536)) then
error(6)
return 0 ' Overflow
end if
port = port and &HFFFF
if (port = &H3C9) then ' read palette
if (write_page->pal) then ' avoid NULL pointer
' convert 0-255 value to 0-63 value
if (H3C9_read_next = 0) then ' red
value = qbr_double_to_long(((cast(double,((write_page->pal[H3C7_palette_register_read_index] _
shr 16) and 255))) / 3.984376 - 0.4999999d))
end if
if (H3C9_read_next = 1) then ' green
value = qbr_double_to_long(((cast(double,((write_page->pal[H3C7_palette_register_read_index] _
shr 8) and 255))) / 3.984376 - 0.4999999d))
end if
if (H3C9_read_next = 2) then ' blue
value = qbr_double_to_long((cast(double,((write_page->pal[H3C7_palette_register_read_index] _
and 255))) / 3.984376 - 0.4999999d))
end if
H3C9_read_next = H3C9_read_next + 1
if (H3C9_read_next = 3) then
H3C9_read_next = 0
H3C7_palette_register_read_index = H3C7_palette_register_read_index + 1
H3C7_palette_register_read_index = &HFF and H3C7_palette_register_read_index
end if
return value
end if '->pal
return 0 ' non-palette modes
end if
/'
3dAh (R): Input Status #1 Register
bit 0 Either Vertical or Horizontal Retrace active if set
1 Light Pen has triggered if set
2 Light Pen switch is open if set
3 Vertical Retrace in progress if set
4-5 Shows two of the 6 color outputs, depending on 3C0h index 12h.
Attr: Bit 4-5: Out bit 4 Out bit 5
0 Blue Red
1 I Blue Green
2 I Red I Green
'/
if (port = &H3DA) then
value = 0
if (vertical_retrace_happened or vertical_retrace_in_progress) then
vertical_retrace_happened = 0
value = value or 8
end if
return value
end if
'
' if (port = &H60) then
' ' return last scancode event
' if (port60h_events) then
' value = port60h_event(0)
' if (port60h_events > 1) then
' memmove(port60h_event, port60h_event + 1, 255)
' end if
' port60h_events = prot60h_events - 1
' return value
' else
' return port60h_event(0)
' end if
' end if
'
unsupported_port_accessed = 1
return 0 ' unknown port!
end proc
def SYSTEM_BUS_T.sub_wait(port as integer, andexpression as integer, xorexpression as integer, passed as integer)
if (new_error) then
return
end if
' 1. read value from port
' 2. value^=xorexpression (if passed!)
' 3. value^=andexpression
' IMPORTANT: Wait returns immediately if given port is unsupported by QB64 so program
' can continue
static as integer value
' error & range checking
if ((port > 65535) or (port < -65536)) then
error(6)
return ' Overflow
end if
port = port and &HFFFF
if ((andexpression < -32768) or (andexpression > 65535)) then
error(6)
return ' Overflow
end if
andexpression = andexpression and &HFF
if (passed) then
if ((xorexpression < -32768) or (xorexpression > 65535)) then
error(6)
return ' Overflow
end if
end if
xorexpression = xorexpression and &HFF
wait_loop:
value = func_inp(port)
if (passed) then
value = value xor xorexpression
end if
value = value and andexpression
if (value or unsupported_port_accessed or stop_program) then
return
end if
Sleep(1)
goto wait_loop
end defRE: It's verification time!!! - fatman2021 - 07-11-2022
Next up is come code from the POV-Ray port:
Code: (Select All)
/' Get minimum/maximum of two values. '/
proc SYSTEM_BUS_T.POV_min(x as DBL, y as DBL) as DBL
return (iif(((x)>(y)),(y),(x)))
end proc
proc SYSTEM_BUS_T.POV_max(x as DBL, y as DBL) as DBL
return (iif(((x)<(y)),(y),(x)))
end proc
/' Get minimum/maximum of three values. '/
proc SYSTEM_BUS_T.POV_min3(x as DBL, y as DBL, z as DBL) as DBL
return iif(x < y , iif(x < z , x , z) , iif(y < z , y , z))
end proc
proc SYSTEM_BUS_T.POV_max3(x as DBL, y as DBL, z as DBL) as DBL
return iif(x > y , iif(x > z , x , z) , iif(y > z , y , z))
end proc
/' Absolute value of the long integer x. '/
proc SYSTEM_BUS_T.POV_labs(x as DBL) as long
return iif(((x)<0),-(x),(x))
end proc
/' Absolute value of the double x. '/
proc SYSTEM_BUS_T.POV_fabs(x as DBL) as DBL
return iif((x) < 0.0 , -(x) , (x))
end proc
/' Stuff for bounding boxes. '/
def SYSTEM_BUS_T.POV_Assign_BBox_Vect(d as DBL ptr, s as DBL ptr)
dim as SYSTEM_TYPE x = fun_pull() ' x = computer.cpU_mos6510->pull()
dim as SYSTEM_TYPE y = fun_pull() ' y = computer.cpU_mos6510->pull()
dim as SYSTEM_TYPE z = fun_pull() ' z = computer.cpU_mos6510->pull()
d[x] = s[x]: d[y] = s[y]: d[z] = s[z]
end def
def SYSTEM_BUS_T.POV_Make_BBox(BBox() as _BBOX,llx as _BBOX_VAL,lly as _BBOX_VAL,llz as _BBOX_VAL, _
lex as _BBOX_VAL,ley as _BBOX_VAL,lez as _BBOX_VAL)
dim as SYSTEM_TYPE x = fun_pull() ' x = computer.cpU_mos6510->pull()
dim as SYSTEM_TYPE y = fun_pull() ' y = computer.cpU_mos6510->pull()
dim as SYSTEM_TYPE z = fun_pull() ' z = computer.cpU_mos6510->pull()
BBox(x).Lower_Left = (llx)
BBox(y).Lower_Left = (lly)
BBox(z).Lower_Left = (llz)
BBox(x).Lengths = (lex)
BBox(y).Lengths = (ley)
BBox(z).Lengths = (lez)
end defRE: It's verification time!!! - fatman2021 - 07-13-2022
Like a BSD distribution, everything is developed and compiled as a single unit.
Code: (Select All)
fbc -fpmode fast -fpu sse -w all "c64dvd-glsl.bas" -map c64dvd-glsl.map -strip -Wc -mcmodel=small -Wc -msse2avx -Wc -Ofast -Wc -ffp-contract=fast -Wc -foptimize-sibling-calls -Wc -foptimize-strlen -Wc -fno-inline -Wc -save-temps -Wc -O3 -Wc -msse2avxREADME.md
https://github.com/fatman2021/project-manhattan/blob/master/README.md
c64dvd-glsl.bas
https://github.com/fatman2021/project-manhattan/blob/master/c64dvd-glsl.bas
RE: It's verification time!!! - fatman2021 - 07-15-2022
![[Image: box.small.jpg]](http://www.graphics.cornell.edu/online/box/box.small.jpg)
Cornell University has a great article about rendering realistic images that is worth checking out:
http://www.graphics.cornell.edu/online/box/data.html
RE: It's verification time!!! - fatman2021 - 07-15-2022
Round cone:
Code: (Select All)
/'
Original Code:
// Round cone - exact
float sdRoundCone( vec3 p, float r1, float r2, float h )
{
// sampling independent computations (only depend on shape)
float b = (r1-r2)/h;
float a = sqrt(1.0-b*b);
// sampling dependant computations
vec2 q = vec2( length(p.xz), p.y );
float k = dot(q,vec2(-b,a));
if( k<0.0 ) return length(q) - r1;
if( k>a*h ) return length(q-vec2(0.0,h)) - r2;
return dot(q, vec2(a,b) ) - r1;
}
Intermediate Code:
double _ZN12SYSTEM_BUS_T11SDROUNDCONEER7VECTOR3ddd( struct $12SYSTEM_BUS_T* THIS$1, struct $7VECTOR3* P$1, \
double R1$1, double R2$1, double H$1 )
{
struct $7VECTOR2 TMP$1959$1;
struct $7VECTOR2 TMP$1960$1;
struct $7VECTOR2 TMP$1963$1;
double fb$result$1;
__builtin_memset( &fb$result$1, 0, 8ll );
label$2277:;
double B$1;
B$1 = (R1$1 - R2$1) / H$1;
double A$1;
double vr$6 = _Z4SQRTd( -(B$1 * B$1) + 0x1.p+0 );
A$1 = vr$6;
struct $7VECTOR2 Q$1;
struct $7VECTOR2* vr$9 = _ZN7VECTOR32XZEv( &TMP$1959$1, P$1 );
double vr$10 = _Z6LENGTHRK7VECTOR2( (struct $7VECTOR2*)vr$9 );
_ZN7VECTOR2C1Edd( &Q$1, vr$10, *(double*)((uint8*)P$1 + 8ll) );
double K$1;
_ZN7VECTOR2C1Edd( &TMP$1960$1, -B$1, A$1 );
double vr$16 = _Z3DOTR7VECTOR2S0_( &Q$1, &TMP$1960$1 );
K$1 = vr$16;
if( K$1 >= 0x0p+0 ) goto label$2280;
{
double vr$18 = _Z6LENGTHRK7VECTOR2( (struct $7VECTOR2*)&Q$1 );
fb$result$1 = vr$18 - R1$1;
goto label$2278;
label$2280:;
}
if( K$1 <= (A$1 * H$1) ) goto label$2282;
{
struct $7VECTOR2 TMP$1961$2;
struct $7VECTOR2 TMP$1962$2;
_ZN7VECTOR2C1Edd( &TMP$1961$2, 0x0p+0, H$1 );
struct $7VECTOR2* vr$25 = _ZmiR7VECTOR2S0_( &TMP$1962$2, &Q$1, &TMP$1961$2 );
double vr$26 = _Z6LENGTHRK7VECTOR2( (struct $7VECTOR2*)vr$25 );
fb$result$1 = vr$26 - R2$1;
goto label$2278;
label$2282:;
}
_ZN7VECTOR2C1Edd( &TMP$1963$1, A$1, B$1 );
double vr$31 = _Z3DOTR7VECTOR2S0_( &Q$1, &TMP$1963$1 );
fb$result$1 = vr$31 - R1$1;
goto label$2278;
label$2278:;
return fb$result$1;
}
FreeBASIC:
'/
proc SYSTEM_BUS_T.sdRoundCone( p as vector3, r1 as float, r2 as float, h as float) as float
' sampling independent computations (only depend on shape)
dim as float b = (r1-r2)/h
dim as float a = sqrt(1.0-b*b)
' sampling dependant computations
dim as vector2 q = vector2( length(p.xz), p.y )
dim as float k = dot(q,vector2(-b,a))
if( k<0.0 ) then return length(q) - r1
if( k>a*h ) then return length(q-vector2(0.0,h)) - r2
return dot(q, vector2(a,b) ) - r1
end procRE: It's verification time!!! - fatman2021 - 07-17-2022
CSNG
Code: (Select All)
' CSNG
proc SYSTEM_BUS_T.func_csng_float(value as float) as float
if ((value <= 3.402823466E38) and (value >= -3.402823466E38)) then
return value
end if
error(6)
return 0
end proc
proc SYSTEM_BUS_T.func_csng_double(value as double) as double
if ((value <= 3.402823466E38) and (value >= -3.402823466E38)) then
return value
end if
error(6)
return 0
end procRE: It's verification time!!! - fatman2021 - 07-19-2022
LibC stuff:
Code: (Select All)
proc SYSTEM_BUS_T.k_min(v1 as SYSTEM_TYPE,v2 as SYSTEM_TYPE) as SYSTEM_TYPE
if (v1<v2) then return v1
return v2
end proc
proc SYSTEM_BUS_T.k_max(v1 as SYSTEM_TYPE,v2 as SYSTEM_TYPE) as SYSTEM_TYPE
if (v1>v2) then return v1
return v2
end proc
proc SYSTEM_BUS_T.k_strlen(s as ubyte ptr) as SYSTEM_TYPE
dim retval as SYSTEM_TYPE
retval=0
while s[retval]<>0
retval+=1
wend
return retval
end proc
proc SYSTEM_BUS_T.k_strtrim(s as ubyte ptr) as ubyte ptr
dim retval as ubyte ptr=@(Result(0))
retval[0]=0
dim i as integer=0
dim j as integer=0
while (s[i]<>0 and s[i]=32 and s[i]<>9 and s[i]<>10 and s[i]<>13)
i+=1
wend
while(s[i]<>0)
retval[j]=s[i]
i+=1
j+=1
wend
retval[j]=0
k_strrev(retval)
i=0
j=0
while (retval[i]<>0 and retval[i]=32 and retval[i]=9 and retval[i]=10 and retval[i]=13)
i+=1
wend
while(retval[i]<>0)
retval[j]=retval[i]
i+=1
j+=1
wend
retval[j]=0
k_strrev(retval)
return retval
end proc
proc SYSTEM_BUS_T.k_strtoupper(s as ubyte ptr) as ubyte ptr
dim i as SYSTEM_TYPE
dim dst as ubyte ptr=@(Result(0))
i=0
while s[i]<>0 and i<1022
if (s[i]>=97 and s[i]<=122) then
dst[i]=s[i]-32
else
dst[i]=s[i]
end if
i+=1
wend
dst[i]=0
return dst
end proc
proc SYSTEM_BUS_T.k_strtolower(s as ubyte ptr) as ubyte ptr
dim i as SYSTEM_TYPE
dim dst as ubyte ptr=@(Result(0))
i=0
while s[i]<>0 and i<1022
if (s[i]>=65 and s[i]<=90) then
dst[i]=s[i]+32
else
dst[i]=s[i]
end if
i+=1
wend
dst[i]=0
return dst
end proc
proc SYSTEM_BUS_T.k_substring(s as ubyte ptr,index as SYSTEM_TYPE, count as SYSTEM_TYPE) as ubyte ptr
dim i as SYSTEM_TYPE
dim dst as ubyte ptr=@(Result(0))
dim l as SYSTEM_TYPE=k_strlen(s)
i=0
while s[i+index]<>0 and i+index<1022 and i+index<l and (i<count or count=-1)
dst[i]=s[i+index]
i+=1
wend
dst[i]=0
return dst
end proc
proc SYSTEM_BUS_T.k_strlastindexof(s as ubyte ptr,s2 as ubyte ptr) as SYSTEM_TYPE
var l1=k_strlen(s)
var l2=k_strlen(s2)
dim i as SYSTEM_TYPE
dim j as SYSTEM_TYPE
var ok=0
for i=l1-l2 to 0 step -1
if s[i]=s2[0] then
ok=1
for j=0 to l2-1
if s[i+j]<>s2[j] then
ok=0
exit for
end if
next j
if ok<>0 then return i
end if
next i
return -1
end proc
proc SYSTEM_BUS_T.k_strendswith(src as ubyte ptr,search as ubyte ptr) as SYSTEM_TYPE
if (k_strlastindexof(src,search) = k_strlen(src)-k_strlen(search)) then
return 1
else
return 0
end if
end procRE: It's verification time!!! - fatman2021 - 07-20-2022
Math Functions
Code: (Select All)
proc SYSTEM_BUS_T.k_f(x as float) as float
return x*x
end proc
proc SYSTEM_BUS_T.k_frexp(d as float, ep as float ptr) as float
static as Cheat x
if(d = 0) then
*ep = 0
return 0
end if
x.d = d
*ep = ((x.ms shr K_SHIFT) and K_MASK) - K_BIAS
x.ms = x.ms and not (K_MASK shl K_SHIFT)
x.ms = x.ms or K_BIAS shl K_SHIFT
return x.d
end proc
proc SYSTEM_BUS_T.k_ldexp(d as float, e as float) as float
static as Cheat x
if(d = 0) then
return 0
end if
x.d = d
e += (x.ms shr K_SHIFT) and K_MASK
if(e <= 0) then
return 0 /' underflow '/
end if
if(e >= K_MASK) then /' overflow '/
if(d < 0) then
return NEG_INF
end if
return POS_INF
end if
x.ms = x.ms and not (K_MASK shl K_SHIFT)
x.ms = x.ms or e shl K_SHIFT
return x.d
end proc
proc SYSTEM_BUS_T.k_sqrt(arg as float) as float
static as float x, temp
static as float _exp, i
if(arg <= 0) then
if(arg < 0) then
return 0.0
end if
return 0
end if
x = k_frexp(arg, @_exp)
while(x < 0.5)
x *= 2
_exp = _exp - 1
wend
/'
' NOTE
' this wont work on 1's comp
'/
if(_exp and 1) then
x *= 2
_exp = _exp - 1
end if
temp = 0.5 * (1.0+x)
while(_exp > 60)
temp *= (1L shl 30)
_exp -= 60
wend
while(_exp < -60)
temp /= (1L shl 30)
_exp += 60
wend
if(_exp >= 0) then
temp *= 1L shl (_exp/2)
else
temp /= 1L shl (-_exp/2)
end if
for i=0 to 4
temp = 0.5*(temp + arg/temp)
next
return temp
end procRE: It's verification time!!! - dbox - 07-20-2022
What is all this?