{ {$MAXSTACKSIZE $7FBE0000} } uses windows, dateutils, atomic, ntapi, mqueue, syscalls, signal, ucontext, _umtx, sys_umtx, time, kern_time, md_time, thr, kern_thread, md_thread, kern_rwlock, thr_private, sys_cpuset, trap, kern_psl, kern_umtx, thr_init, thr_error, pthread_md, sysutils, errno, md_context, subr_sleepqueue, kern_thr, kern_condvar, kern_osem, kern_id, kern_evf, rtprio, pthread, thr_stack, sys_mmap, kern_synch, murmurhash, hamt, vfs_subr, vfs_mount, vfs_default, init_sysent, vfs_syscalls, vsys_generic, vsocket, vsocketvar, vnode_if, sys_sysinit, sys_fnmatch, dead_vnops, devfs, devfs_devs, devfs_rule, devfs_vfsops, devfs_vnops, vfs_mountroot, vstat, vfcntl, vdirent, fdesc_vfsops, fdesc_vnops, fdescfs, kern_descrip, vnode, nullfs, null_subr, null_vnops, null_vfsops, ufs, vmount, kern_prot, sys_resource, kern_resource, md_proc, kern_ksched, kern_uuid, kern_gpo, md_sleep, sys_machdep, kern_context, kern_namedobj, sys_event, sys_eventvar, kern_event, kern_timeout, kern_exec, kern_dynlib, vmparam, kern_sysctl, kern_budget, kern_regmgr, kern_authinfo, kern_dmem, kern_blockpool, kern_bnet, uipc_syscalls, kern_ipmimgr, kern_mdbg, md_exception, systm, dev_tty, sys_crt, ps4_libSceSystemService, ps4_libSceIpmi, ps4_libSceDialogs, ps4_libSceAvSetting; var mtx:umutex; rwl:urwlock; e:Integer; event:Thandle; //osem:Integer; evf:Integer; procedure trap_test; var td:p_kthread; begin td:=curkthread; Writeln('trap_test: ',' curkthread:',HexStr(curkthread),' sptr:',HexStr(sptr),' ',HexStr(td^.td_frame.tf_rip,16)); end; function _thread(parameter:pointer):ptrint; var td:p_kthread; p:Pointer; qr:t_query_memory_prot; begin Result:=0; NtWaitForSingleObject(event,false,nil); td:=thread_alloc; td^.td_tid :=GetCurrentThreadId; td^.td_handle:=GetCurrentThread; td^.td_ref :=1; //sched_priority(@td,700); BaseQueryInfo(td); set_curkthread(td); p:=mmap(Pointer($700000000),16*1024,PROT_CPU_ALL,MAP_VOID or MAP_FIXED,-1,0); Writeln(HexStr(p)); p:=mmap(Pointer($700000000),16*1024,PROT_CPU_ALL,MAP_ANON or MAP_FIXED,-1,0); Writeln(HexStr(p)); Result:=query_memory_protection(Pointer($700000000),@qr); Writeln(Result); sceKernelSetVirtualRangeName(Pointer($700000000),16*1024,'test'); p:=mmap(Pointer($700000000+16*1024),16*1024,PROT_CPU_ALL,MAP_ANON {or MAP_VOID} or MAP_FIXED,-1,0); Writeln(HexStr(p)); Result:=madvise(Pointer($00700000000),4*1024,MADV_FREE); Writeln(Result); Result:=madvise(Pointer($00700000000),4*1024,MADV_WILLNEED); Writeln(Result); Result:=munmap(Pointer($700000000),16*1024*2); Writeln(Result); e:=_umtx_op(nil,UMTX_OP_RW_WRLOCK,0,nil,nil); Writeln(' e=',e); repeat //Writeln('before: sptr:',HexStr(sptr)); //asm // Movq trap_test,%rax // call fast_syscall //end; //Writeln('after: sptr:',HexStr(sptr)); //e:=_umtx_op(@mtx,{UMTX_OP_MUTEX_LOCK} UMTX_OP_LOCK,td.td_tid,nil,nil); //e:=_umtx_op(@mtx,UMTX_OP_MUTEX_LOCK,td^.td_tid,nil,nil); e:=_umtx_op(@rwl,UMTX_OP_RW_WRLOCK,0,nil,nil); Writeln(' lock[',GetCurrentThreadId,'] ',e); //e:=_do_lock_normal(GetCurrentThreadId,@mtx,0,NT_INFINITE,0); //Writeln(' lock[',GetCurrentThreadId,'] ',e); //sleep(100); //Writeln('before: sptr:',HexStr(sptr)); //e:=_umtx_op(@mtx,{UMTX_OP_MUTEX_UNLOCK} UMTX_OP_UNLOCK,td.td_tid,nil,nil); //e:=_umtx_op(@mtx,UMTX_OP_MUTEX_UNLOCK,td^.td_tid,nil,nil); e:=_umtx_op(@rwl,UMTX_OP_RW_UNLOCK,0,nil,nil); Writeln('unlock[',GetCurrentThreadId,'] ',e); //Writeln('after: sptr:',HexStr(sptr)); //sleep(1000) //_umtx_obj_done(@mtx); until false; end; var mem,mem2:Pointer; mseg:Pointer; lock:Integer; procedure _writefsbase_u64(base:Pointer); begin asm Mov base,%rax //f3 48 0f ae d0 WRFSBASE RAX .byte 0xF3 .byte 0x48 .byte 0x0F .byte 0xAE .byte 0xD0 end; end; function _readfsbase_u64:Pointer; begin asm push %rsi //f3 48 0f ae c6 RDFSBASE RSI .byte 0xF3 .byte 0x48 .byte 0x0F .byte 0xAE .byte 0xC6 Mov %rsi,Result pop %rsi end; end; procedure SetTlsBase(p:Pointer); assembler; nostackframe; asm mov %rcx,%gs:(0x708) end; function GetTlsBase:Pointer; assembler; nostackframe; asm mov %gs:(0x708),%rax end; function Get_SEH:Pointer; assembler; nostackframe; asm mov %gs:(0),%rax end; threadvar intr:Integer; procedure __ex_handler(sig,code:Integer;ctx:p_ucontext_t); SysV_ABI_CDecl; begin intr:=1; Writeln('__ex_handler:',sig,' ',code); end; var tid,tid2:QWORD; var xmm0:array[0..15] of Byte=(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1); xmm0_ptr:Pointer=@xmm0; ymm0:array[0..31] of Byte=(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1); ymm0_ptr:Pointer=@ymm0; function ts_to_str(ts:timespec):RawByteString; var D:TDateTime; begin D:=UnixToDateTime(ts.tv_sec); D:=UniversalTimeToLocal(D); Result:=DateTimeToStr(D); end; function IncludeUnixTrailing(Const Path:RawByteString):RawByteString; Var L:Integer; begin Result:=Path; L:=Length(Result); If (L=0) or (Path[L]<>'/') then begin SetLength(Result,L+1); Result[L+1]:='/'; end; end; procedure test_files; var td:p_kthread; fs:t_statfs; fd_1,fd_2:Integer; i,err:Integer; buf:PChar; argv0:PChar; begin td:=curkthread; { Writeln('sys_open=',sys_open('/app0/test.txt',O_RDWR or O_CREAT or O_TRUNC{ or O_APPEND} or O_EXLOCK,&777)); fd_1:=td^.td_retval[0]; buf:=AllocMem(64*1024); FillChar(buf^,64*1024,'0'); Writeln('sys_pwrite=',sys_pwrite(fd_1,buf,64*1024,0)); FillChar(buf^,64*1024,'1'); Writeln('sys_pwrite=',sys_pwrite(fd_1,buf,64*1024,0)); FillChar(buf^,64*1024,0); Writeln('sys_pread=',sys_pread(fd_1,buf,64*1024,0)); FreeMem(buf); //Writeln('sys_fstatfs=',sys_fstatfs(fd_1,@fs)); Writeln('sys_fsync=',sys_fsync(fd_1)); Writeln('sys_fdatasync=',sys_fdatasync(fd_1)); Writeln('sys_open=',sys_open('/app0/test.txt',O_RDWR{ or O_CREAT},&777)); fd_2:=td^.td_retval[0]; Writeln('sys_close=',sys_close(fd_2)); Writeln('sys_close=',sys_close(fd_1)); Writeln('sys_mkdir=',sys_mkdir('/test',&777)); Writeln('sys_mkdir=',sys_mkdir('/test/test',&777)); Writeln('sys_rmdir=',sys_rmdir('/test/test')); Writeln('sys_symlink=',sys_symlink('/app0','/test/test2')); Writeln('sys_unlink=',sys_unlink('/test/test2')); Writeln('sys_mkdir=',sys_mkdir('/app0/new',&777)); Writeln('sys_link=',sys_link('/app0/test.txt','/app0/new/test_link.txt')); Writeln('sys_rename=',sys_rename('/app0/new/test_link.txt','/app0/renamed')); Writeln('sys_unlink=',sys_unlink('/app0/renamed')); Writeln('sys_rename=',sys_rename('/app0/new','/app0/renamed')); Writeln('sys_rmdir=',sys_rmdir('/app0/renamed')); Writeln('sys_unlink=',sys_unlink('/app0/test.txt')); Writeln('sys_rmdir=',sys_rmdir('/test')); } //readln; //fs guest host err:=vfs_mount_mkdir('ufs','/app0' ,'/' ,nil,0); err:=vfs_mount_mkdir('ufs','/system','/system',nil,0); err:=vfs_mount_mkdir('ufs','/data' ,'/data' ,nil,0); //argv0:='/app0/basic-sample_debug.elf'; //argv0:='/app0/simple.elf'; //argv0:='/app0/videoout_basic.elf'; argv0:='/app0/videoout_basic.bin'; //argv0:='/app0/videoout_cursor.elf'; //argv0:='/app0/scene2.bin'; //argv0:='/app0/basic_quad_debug.elf'; //argv0:='/app0/hello_world9.bin'; err:=_execve(argv0,@argv0,nil); end; procedure test_dirs(const dirp,namep:RawByteString;s:Byte); label _next; var td:p_kthread; sb:t_stat; buf:array[0..511] of Byte; dir:p_dirent; fd:Integer; err:Integer; c:Integer; begin td:=curkthread; case RawByteString(namep) of '.', '..': begin Writeln(Space(s),namep:20,' |'); Exit; end; else; end; err:=sys_lstat(PChar(dirp+namep),@sb); //err:=sys_stat(PChar(dirp+namep),@sb); if (err<>0) then begin Writeln(Space(s),namep:20,' | (',err,')'); end else begin Write(Space(s),namep:20,' | ',ts_to_str(sb.st_birthtim {st_mtim}):19,' |'); _next: if ((sb.st_mode and S_IFDIR)<>0) then begin Write(' DIR'); Assert(sb.st_size=512); err:=sys_open(PChar(dirp+namep),O_RDONLY or O_DIRECTORY,0); if (err<>0) then begin Write(' | (',err,')'); Exit; end else begin Writeln; end; fd:=td^.td_retval[0]; Writeln(Space(s),'->'); repeat FillChar(buf,512,0); dir:=@buf; err:=sys_getdents(fd,dir,512); if (err<0) then Break; c:=td^.td_retval[0]; if (c=0) then Break; while (dir<(@buf+c)) do begin test_dirs(IncludeUnixTrailing(dirp+namep),RawByteString(dir^.d_name),s+2); PByte(dir):=PByte(dir)+dir^.d_reclen; end; until false; sys_close(fd); Writeln(Space(s),'<-'); end else begin Case (sb.st_mode and S_IFMT) of S_IFIFO :Write(' IFO'); S_IFCHR :Write(' CHR'); S_IFDIR :Write(' DIR'); S_IFBLK :Write(' BLK'); S_IFREG :Write(' REG'); S_IFLNK :Write(' LNK'); S_IFSOCK:Write(' SCK'); else Write(' ',(sb.st_mode and S_IFMT)); end; Writeln(' | ',sb.st_size); end; end; end; procedure _timerexpire(arg:Pointer); sysv_abi_default; var calloutp:p_callout; begin calloutp:=arg; writeln('_timerexpire'); callout_reset_curcpu(calloutp, 1000*1000*UNIT_PER_USEC-1, @_timerexpire, calloutp); //callout_drain(calloutp); end; { Type TBacktraceStrFunc = Function (Addr: CodePointer): ShortString; TErrorProc = Procedure (ErrNo : Longint; Address : CodePointer; Frame : Pointer); TAbstractErrorProc = Procedure; TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno:longint;erroraddr:pointer); TSafeCallErrorProc = Procedure(error : HResult;addr : pointer); const BacktraceStrFunc : TBacktraceStrFunc = @SysBacktraceStr; ErrorProc : TErrorProc = nil; AbstractErrorProc : TAbstractErrorProc = nil; AssertErrorProc : TAssertErrorProc = @SysAssert; SafeCallErrorProc : TSafeCallErrorProc = nil; } procedure test_thread; sysv_abi_default; var rax:qword; act:sigaction_t; _sig:Integer; oset:sigset_t; i,t:Integer; uctx:ucontext_t; calloutp:p_callout; begin writeln('Get_SEH:0x',HexStr(Get_SEH)); //writeln('copyin:',copyin(mem2+64*1024*4-(sizeof(ucontext_t) div 2),@uctx,sizeof(ucontext_t))); //PPointer(nil)^:=nil; //Assert(false,'test assert'); //if (tid<>curkthread^.td_tid) then //begin // calloutp:=AllocMem(SizeOf(t_callout)); // callout_init(calloutp, CALLOUT_MPSAFE); // callout_reset_curcpu(calloutp, 1000*1000*UNIT_PER_USEC, @_timerexpire, calloutp); //end; //SetTlsBase(Pointer(qword(1))); if (tid<>curkthread^.td_tid) then begin test_files; Writeln('[--test_dirs--]'); test_dirs('','/',1); Writeln('[--test_dirs--]'); //readln; tid2:=curkthread^.td_tid; evf:=evf_create('evf test',EVF_ATTR_TH_PRIO,0); Writeln('evf=',evf,' _errno:',__error^); //osem:=osem_create('osem test',1,1,10); //Writeln('osem=',osem,' _errno:',__error^); act:=Default(sigaction_t); act.u.sa_handler:=sa_handler(@__ex_handler); act.sa_flags:=SA_RESTART; _sigaction(SIGUSR1,@act,nil); i:=syscalls.thr_suspend_ucontext(tid); Writeln('thr_suspend_ucontext:',i); i:=syscalls.thr_get_ucontext(tid,@uctx); Writeln('thr_get_ucontext:',i); i:=syscalls.thr_resume_ucontext(tid); Writeln('thr_resume_ucontext:',i); thr_kill(tid,SIGUSR1); //thr_wake(tid); thr_kill(tid,SIGUSR1); i:=evf_trywait(evf,1,EVF_WAITMODE_OR,nil); Writeln('_evf_trywait_err=',i,' _errno:',__error^); i:=evf_wait(evf,2,EVF_WAITMODE_OR,nil,nil); Writeln('_evf_wait_err=',i,' _errno:',__error^); //i:=_osem_wait_err(osem,1,nil); //Writeln('_osem_wait_err=',i,' _errno:',__error^); // //t:=400; //i:=_osem_wait_err(osem,1,nil); //Writeln('_osem_wait_err=',i,' _errno:',__error^); // //i:=_osem_delete_err(osem); //Writeln('_osem_delete_err=',i,' _errno:',__error^); writeln; end else begin //Writeln('thr_suspend:',thr_suspend(nil)); { oset.qwords[0]:=QWORD(-1); oset.qwords[1]:=QWORD(-1); Writeln('sigwait:',sigwait(@oset,@_sig)); Writeln('intr:',_sig); } Writeln('before: sptr:',HexStr(sptr)); asm movqq xmm0_ptr,%rax movdqu (%rax),%xmm0 movqq ymm0_ptr,%rax vmovdqu (%rax),%ymm0 end; syscalls.getcontext(@uctx); oset.qwords[0]:=QWORD(-1); oset.qwords[1]:=QWORD(-1); Writeln('sigwait:',sigwait(@oset,@_sig)); Writeln('_errno:',__error^); //repeat // asm // pause // end; //until (intr<>0); asm movqq xmm0_ptr,%rax movdqu %xmm0,(%rax) movqq ymm0_ptr,%rax vmovdqu %ymm0,(%rax) end; Writeln('intr'); Writeln('after: sptr:',HexStr(sptr)); end; sleep(500); //_osem_post_err(osem,1); thr_kill(tid2,SIGUSR1); i:=evf_set(evf,2); i:=evf_set(evf,1); Writeln('_evf_set_err=',i,' _errno:',__error^); //_osem_post_err(osem,1); sig_lock; sig_lock; sleep(1); sig_unlock; sig_unlock; { rax:=0; asm mov %gs:(0x1C0),%rax end; Writeln('SpareBytes1[0]:',HexStr(rax,16)); rax:=0; asm mov %gs:(0x1C8),%rax end; Writeln('SpareBytes1[1]:',HexStr(rax,16)); rax:=0; asm mov %gs:(0x1D0),%rax end; Writeln('SpareBytes1[2]:',HexStr(rax,16)); Writeln('GetTlsBase:',HexStr(GetTlsBase)); rax:=0; asm mov %gs:(0x10),%rax mov %rax,rax end; Writeln('FiberData:',HexStr(rax,16)); rax:=0; asm mov %gs:(0x14),%rax mov %rax,rax end; Writeln('ArbitraryData:',HexStr(rax,16)); rax:=0; asm mov %gs:(0xC0),%rax mov %rax,rax end; Writeln('Wow64:',HexStr(rax,16)); rax:=0; asm mov %gs:(0x1A8),%rax mov %rax,rax end; Writeln('ActivationContextStack:',HexStr(rax,16)); rax:=0; asm mov %gs:(0x700),%rax mov %rax,rax end; Writeln('UserData[0]:',HexStr(rax,16)); rax:=0; asm mov %gs:(0x708),%rax mov %rax,rax end; Writeln('UserData[1]:',HexStr(rax,16)); rax:=0; asm mov %gs:(0x710),%eax mov %rax,rax end; Writeln('UserData[2]:',HexStr(rax,8)); rax:=0; asm mov %gs:(0xE0C),%rax mov %rax,rax end; Writeln('DeallocationStack:',HexStr(rax,16)); Writeln('mseg:',HexStr(mseg)); FillChar(mseg^,64*1024,$11); PQWORD(mseg)^:=$0102030405060708; Writeln('_readfsbase_u64:',HexStr(_readfsbase_u64)); _writefsbase_u64(mseg); //Writeln('_readfsbase_u64:',HexStr(_readfsbase_u64)); //rax:=qword(mseg); asm // Mov rax,%rax // // .byte 0xF3 // .byte 0x48 // .byte 0x0F // .byte 0xAE // .byte 0xD0 // // //F3 0F AE // //f3 48 0f ae d0 WRFSBASE RAX // // movq %fs:(0),%rax //f3 48 0f ae d0 WRFSBASE RAX end; //sleep(1); //Writeln('_readfsbase_u64:',HexStr(_readfsbase_u64)); //While (XCHG(lock,1)<>0) do spin_pause; rax:=0; asm movq %fs:(0),%rax Mov %rax,rax end; writeln(HexStr(rax,16)); writeln; } thr_exit(nil); end; function _VirtualQuery(addr:Pointer):Integer; var Info:TMemoryBasicInformation; begin Writeln('-----'); Info:=Default(TMemoryBasicInformation); Result:=NtQueryVirtualMemory( NtCurrentProcess, @addr, MemoryBasicInformation, @Info, SizeOf(TMemoryBasicInformation), nil); //Result:=VirtualQuery(addr,Info,SizeOf(TMemoryBasicInformation)); //if (Result=0) then //begin // Result:=GetLastError; //end else if (Result=0) then begin //Result:=0; Writeln('Q:BaseAddress :',HexStr(Info.BaseAddress)); Writeln('Q:AllocationBase:',HexStr(Info.AllocationBase)); //AllocationProtect : DWORD; Writeln('Q:RegionSize :',HexStr(Info.RegionSize,16)); Write ('Q:State :'); Case Info.State of MEM_COMMIT :Writeln('MEM_COMMIT '); MEM_RESERVE:Writeln('MEM_RESERVE'); MEM_FREE :Writeln('MEM_FREE '); end; Write ('Q:Protect :'); Case Info.Protect of 0 :Writeln('0'); PAGE_NOACCESS :Writeln('PAGE_NOACCESS '); PAGE_READONLY :Writeln('PAGE_READONLY '); PAGE_READWRITE :Writeln('PAGE_READWRITE '); PAGE_EXECUTE :Writeln('PAGE_EXECUTE '); PAGE_EXECUTE_READ :Writeln('PAGE_EXECUTE_READ '); PAGE_EXECUTE_READWRITE:Writeln('PAGE_EXECUTE_READWRITE'); else; end; Write ('Q:Type :'); Case Info._Type of 0 :Writeln('0'); MEM_PRIVATE:Writeln('MEM_PRIVATE'); MEM_MAPPED :Writeln('MEM_MAPPED '); MEM_IMAGE :Writeln('MEM_IMAGE '); end; end; Writeln('-----'); end; procedure test_map2; var hSection:THandle; place_base:Pointer; base:Pointer; size:ULONG_PTR; SectionOffset:ULONG_PTR; R:DWORD; old:Integer; begin exit; place_base:=nil; size:=4*1024*1024; R:=NtAllocateVirtualMemoryEx( NtCurrentProcess, @place_base, @size, MEM_RESERVE or MEM_RESERVE_PLACEHOLDER, PAGE_NOACCESS, nil, 0 ); Writeln('NtAllocateVirtualMemoryEx:',HexStr(R,8)); Writeln('place_base:',HexStr(place_base)); base:=place_base; size:=4*1024; //split region R:=NtFreeVirtualMemory( NtCurrentProcess, @base, @size, MEM_RELEASE or MEM_PRESERVE_PLACEHOLDER ); Writeln('NtFreeVirtualMemory:',HexStr(R,8)); size:=1*1024*1024*1024; //create page file hSection:=0; R:=NtCreateSection( @hSection, SECTION_MAP_WRITE or SECTION_MAP_READ{ or SECTION_MAP_EXECUTE}, nil, @size, PAGE_READWRITE, SEC_COMMIT, THandle(0) ); Writeln('NtCreateSection:',HexStr(R,8)); { HANDLE CreateFileMappingA( [in] HANDLE hFile, [in, optional] LPSECURITY_ATTRIBUTES lpFileMappingAttributes, [in] DWORD flProtect, [in] DWORD dwMaximumSizeHigh, [in] DWORD dwMaximumSizeLow, [in, optional] LPCSTR lpName ); } base:=place_base; SectionOffset:=4*1024; size:=4*1024; R:=NtMapViewOfSectionEx( hSection, NtCurrentProcess, @base, @SectionOffset, @size, MEM_REPLACE_PLACEHOLDER, PAGE_READWRITE, nil, 0 ); Writeln('NtMapViewOfSectionEx:',HexStr(R,8)); old:=0; R:=NtProtectVirtualMemory( NtCurrentProcess, @base, @size, PAGE_READONLY, @old ); Writeln('NtProtectVirtualMemory:',HexStr(R,8)); old:=0; R:=NtProtectVirtualMemory( NtCurrentProcess, @base, @size, PAGE_READWRITE, @old ); Writeln('NtProtectVirtualMemory:',HexStr(R,8)); //private base:=place_base+4*1024; size:=4*1024; //split region R:=NtFreeVirtualMemory( NtCurrentProcess, @base, @size, MEM_RELEASE or MEM_PRESERVE_PLACEHOLDER ); Writeln('NtFreeVirtualMemory:',HexStr(R,8)); base:=place_base+4*1024; SectionOffset:=4*1024; size:=4*1024; R:=NtMapViewOfSectionEx( hSection, NtCurrentProcess, @base, @SectionOffset, @size, MEM_REPLACE_PLACEHOLDER, PAGE_READWRITE, nil, 0 ); Writeln('NtMapViewOfSectionEx:',HexStr(R,8)); { base:=place_base+4*1024; size:=4*1024; R:=NtAllocateVirtualMemoryEx( NtCurrentProcess, @base, @size, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE, nil, 0 ); Writeln('NtAllocateVirtualMemoryEx:',HexStr(R,8)); } PByte(place_base)^:=$FF; Writeln(PByte(base)^); base:=place_base+4*1024; R:=NtUnmapViewOfSectionEx( NtCurrentProcess, base, MEM_PRESERVE_PLACEHOLDER ); Writeln('NtUnmapViewOfSectionEx:',HexStr(R,8)); base:=place_base+4*1024; size:=4*1024*1024-4*1024; //union region R:=NtFreeVirtualMemory( NtCurrentProcess, @base, @size, MEM_RELEASE or MEM_COALESCE_PLACEHOLDERS ); Writeln('NtFreeVirtualMemory:',HexStr(R,8)); readln; end; procedure test_map; var F:THandle; n:Integer; SectionSize:LARGE_INTEGER; start:ULONG_PTR; CommitSize:ULONG_PTR; ViewSize:ULONG_PTR; hSection:THandle; Base1,Base2:Pointer; //dev:TVkDeviceMemory; begin { Base1:=nil; ViewSize:=438*1024*1024*1024; n:=NtAllocateVirtualMemory( NtCurrentProcess, @Base1, 0, @ViewSize, MEM_RESERVE, PAGE_NOACCESS ); Writeln('NtAllocateVirtualMemory:',HexStr(n,8)); Writeln('Base1:',HexStr(Base1)); _VirtualQuery(Base1); readln; } F:=0; //page file F:=FileCreate('pagefile'); FileTruncate(F,64*1024-10); SectionSize.QuadPart:={64*1024} {428*1024*1024*1024} 64*1024-10 { $FFFFFFFFFF}; n:=NtCreateSection( @hSection, //{SECTION_EXTEND_SIZE or} SECTION_MAP_READ or SECTION_MAP_WRITE or SECTION_MAP_EXECUTE, //SECTION_EXTEND_SIZE or SECTION_ALL_ACCESS, SECTION_MAP_READ, nil, @SectionSize, //PAGE_READWRITE, PAGE_READONLY, //PAGE_EXECUTE_READWRITE, SEC_COMMIT, //SEC_RESERVE, F ); Writeln('NtCreateSection:',HexStr(n,8)); //0123456789ABCDEF0123456789ABCDEF01234567 16+16+7=39 39-11-28 48-39=9 //1111111111111111111111111111111111111111 //0000000000000000000000000001000000000000 // BA9876543210 //SectionSize.QuadPart:={64*1024} {428*1024*1024*1024} $FFFFFFFFFF; //n:=NtExtendSection( // hSection, // @SectionSize // ); // //Writeln('NtExtendSection:',HexStr(n,8)); Base1:=nil; Base2:=nil; ViewSize:={64*1024} 16*1024*1024*1024; start:=0; // CommitSize:=64*1024; ViewSize:=64*1024-10; n:=NtMapViewOfSection(hSection, NtCurrentProcess, @Base1, 0, CommitSize, nil, @ViewSize, ViewUnmap, 0 {MEM_RESERVE}, {PAGE_READWRITE} PAGE_READONLY ); Writeln('NtMapViewOfSection:',HexStr(n,8)); Writeln('Base1:',HexStr(Base1)); _VirtualQuery(Base1); // ViewSize:=64*1024; n:=NtMapViewOfSection(hSection, NtCurrentProcess, @Base2, 0, 0, nil, @ViewSize, ViewUnmap, 0 {MEM_RESERVE}, PAGE_READWRITE); Writeln('NtMapViewOfSection:',HexStr(n,8)); Writeln('Base2:',HexStr(Base2)); // ViewSize:=64*1024; n:=NtAllocateVirtualMemory( NtCurrentProcess, @Base1, 0, @ViewSize, MEM_COMMIT, PAGE_READWRITE ); Writeln('NtAllocateVirtualMemory:',HexStr(n,8)); Writeln('Base1:',HexStr(Base1)); _VirtualQuery(Base1); // ViewSize:=64*1024; n:=NtAllocateVirtualMemory( NtCurrentProcess, @Base2, 0, @ViewSize, MEM_COMMIT, PAGE_READWRITE ); Writeln('NtAllocateVirtualMemory:',HexStr(n,8)); Writeln('Base2:',HexStr(Base2)); // PQWORD(Base1)^:=12345; Writeln(PQWORD(Base2)^); //InitVulkan; //dev:=vkAllocHostPointer(Device.FHandle,ViewSize,0,Base1); // //n:=NtUnmapViewOfSection( // NtCurrentProcess, // Base1 // ); // //Writeln('NtUnmapViewOfSection:',HexStr(n,8)); //n:=NtFreeVirtualMemory( // NtCurrentProcess, // @Base1, // @ViewSize, // MEM_RESET // ); // //Writeln('NtFreeVirtualMemory:',HexStr(n,8)); n:=NtProtectVirtualMemory( NtCurrentProcess, @Base1, @ViewSize, PAGE_NOACCESS, @start ); Writeln('NtProtectVirtualMemory:',HexStr(n,8)); Writeln('Base1:',HexStr(Base1)); _VirtualQuery(Base1); Writeln(PQWORD(Base2)^); PQWORD(Base2)^:=6789; end; procedure id_test; var table:t_id_desc_table; desc :t_id_desc; key :Integer; res :Boolean; procedure print_table; begin Writeln('table.FCount=',table.FCount); Writeln('table.FSpace=',table.FSpace); Writeln('table.FLast =',table.FLast ); Writeln('table.FPos =',table.FPos ); end; begin id_table_init(@table,1,5); desc:=Default(t_id_desc); key:=0; // res:=id_new(@table,@desc,@key); Writeln(res,' ',key); print_table; // res:=id_new(@table,@desc,@key); Writeln(res,' ',key); print_table; // res:=id_new(@table,@desc,@key); Writeln(res,' ',key); print_table; // res:=id_new(@table,@desc,@key); Writeln(res,' ',key); print_table; // key:=3; res:=id_del(@table,key,nil); Writeln(res,' ',key); print_table; // key:=4; res:=id_del(@table,key,nil); Writeln(res,' ',key); print_table; // res:=id_new(@table,@desc,@key); Writeln(res,' ',key); print_table; id_table_fini(@table); end; type p_test_tailq=^test_tailq; test_tailq=packed record stub:array[0..2] of qword; entry:TAILQ_ENTRY; name:PChar; end; procedure tailq; var list:TAILQ_HEAD; e,n:p_test_tailq; begin TAILQ_INIT(@list); e:=AllocMem(SizeOf(test_tailq)); e^.name:='one'; //TAILQ_INSERT_TAIL(@list,e,@e^.entry); TAILQ_INSERT_HEAD(@list,e,@e^.entry); e:=AllocMem(SizeOf(test_tailq)); e^.name:='two'; //TAILQ_INSERT_TAIL(@list,e,@e^.entry); TAILQ_INSERT_HEAD(@list,e,@e^.entry); e:=AllocMem(SizeOf(test_tailq)); e^.name:='thr'; //TAILQ_INSERT_TAIL(@list,e,@e^.entry); TAILQ_INSERT_HEAD(@list,e,@e^.entry); Writeln('TAILQ_FIRST'); e:=TAILQ_FIRST(@list); while (e<>nil) do begin Writeln(e^.name); e:=TAILQ_NEXT(e,@e^.entry); end; Writeln('TAILQ_LAST'); e:=TAILQ_LAST(@list); while (e<>nil) do begin Writeln(e^.name); e:=TAILQ_PREV(e,@e^.entry); end; Writeln('TAILQ_REMOVE'); e:=TAILQ_FIRST(@list); while (e<>nil) do begin n:=TAILQ_NEXT(e,@e^.entry); // TAILQ_REMOVE(@list,e,@e^.entry); Writeln(e^.name); FreeMem(e); // e:=n; end; // LIST_INIT(@list); e:=AllocMem(SizeOf(test_tailq)); e^.name:='one'; LIST_INSERT_HEAD(@list,e,@e^.entry); e:=AllocMem(SizeOf(test_tailq)); e^.name:='two'; LIST_INSERT_HEAD(@list,e,@e^.entry); e:=AllocMem(SizeOf(test_tailq)); e^.name:='thr'; LIST_INSERT_HEAD(@list,e,@e^.entry); Writeln('LIST_FIRST'); e:=LIST_FIRST(@list); while (e<>nil) do begin Writeln(e^.name); e:=LIST_NEXT(e,@e^.entry); end; //REMOVE Writeln('LIST_REMOVE'); e:=LIST_FIRST(@list); while (e<>nil) do begin n:=LIST_NEXT(e,@e^.entry); // LIST_REMOVE(e,@e^.entry); Writeln(e^.name); FreeMem(e); // e:=n; end; // STAILQ_INIT(@list); e:=AllocMem(SizeOf(test_tailq)); e^.name:='one'; STAILQ_INSERT_TAIL(@list,e,@e^.entry); //STAILQ_INSERT_HEAD(@list,e,@e^.entry); e:=AllocMem(SizeOf(test_tailq)); e^.name:='two'; STAILQ_INSERT_TAIL(@list,e,@e^.entry); //STAILQ_INSERT_HEAD(@list,e,@e^.entry); e:=AllocMem(SizeOf(test_tailq)); e^.name:='thr'; STAILQ_INSERT_TAIL(@list,e,@e^.entry); //STAILQ_INSERT_HEAD(@list,e,@e^.entry); Writeln('STAILQ_FIRST'); e:=STAILQ_FIRST(@list); while (e<>nil) do begin Writeln(e^.name); e:=STAILQ_NEXT(e,@e^.entry); end; writeln; Writeln('STAILQ_LAST'); e:=STAILQ_LAST(@list,@p_test_tailq(nil)^.entry); Writeln(e^.name); Writeln('STAILQ_REMOVE'); e:=STAILQ_FIRST(@list); while (e<>nil) do begin n:=STAILQ_NEXT(e,@e^.entry); // STAILQ_REMOVE(@list,e,@e^.entry); Writeln(e^.name); FreeMem(e); // e:=n; end; // writeln; end; var ThreadHandle:THandle; v:Integer; n:Integer; prio:t_rtprio; ktd:p_kthread; _time:Int64; _tv:timeval; _thr_param:thr_param; _uctx:ucontext_t; ru:t_rusage; begin //tailq; id_test; //test_map; test_map2; sys_init; //Writeln(get_proc_prio()); //Writeln(set_proc_prio(14)); //Writeln(get_proc_prio()); //Writeln(sys_getrusage(RUSAGE_SELF,@ru)); //Writeln(sys_getrusage(RUSAGE_THREAD,@ru)); e:=_umtx_op(nil,UMTX_OP_RW_WRLOCK,0,nil,nil); Writeln('me=',e,' _errno:',__error^); //kern_clock_gettime_unit(CLOCK_PROCTIME,@_time); //writeln(_time/10000000:0:3); sys_adjtime(nil,@_tv); writeln(_tv.tv_sec,',',_tv.tv_usec); e:=NtCreateEvent( @event, EVENT_ALL_ACCESS, nil, NotificationEvent, False); _umutex_init(@mtx); //mtx.m_flags:=UMUTEX_PRIO_INHERIT; mtx.m_flags:=UMUTEX_PRIO_PROTECT; mseg:=VirtualAlloc(nil,64*1024,MEM_COMMIT,PAGE_READWRITE); mem:=VirtualAlloc(nil,64*1024,MEM_COMMIT,PAGE_READWRITE); mem2:=VirtualAlloc(nil,64*1024,MEM_COMMIT,PAGE_READWRITE); prio._type:=RTP_PRIO_NORMAL; prio._prio:=700; _thr_param:=Default(thr_param); _thr_param.start_func:=@test_thread; _thr_param.arg :=nil; _thr_param.stack_base:=mem; _thr_param.stack_size:=64*1024; _thr_param.tls_base :=mem; _thr_param.child_tid :=@tid; _thr_param.parent_tid:=nil; _thr_param.rtp :=@prio; _thr_param.name :='test'; thr_new(@_thr_param,SizeOf(_thr_param)); _thr_param.start_func:=@test_thread; _thr_param.arg :=nil; _thr_param.stack_base:=mem2; _thr_param.stack_size:=64*1024; _thr_param.tls_base :=mem2; _thr_param.child_tid :=nil; _thr_param.parent_tid:=nil; _thr_param.rtp :=@prio; _thr_param.name :='test2'; thr_new(@_thr_param,SizeOf(_thr_param)); //_uctx:=Default(ucontext_t); //_uctx.uc_mcontext.mc_len:=sizeof(mcontext_t); // //_uctx.uc_mcontext.mc_rsp:=qword(_thr_param.stack_base)+_thr_param.stack_size-8; //_uctx.uc_mcontext.mc_rip:=qword(@test_thread); // //thr_create(@_uctx,nil,0); //readln; sleep(500); ktd:=tdfind(tid); //NtSuspendThread(ktd^.td_handle,nil); //NtResumeThread(ktd^.td_handle,nil); sleep(-1); //readln; FillChar(mseg^,64*1024,$11); ThreadHandle:=BeginThread(@_thread); { For v:=-16 to 16 do begin n:=NtSetInformationThread(ThreadHandle,ThreadBasePriority,@v,SizeOf(Integer)); if (n=0) then Writeln('v:',v,' ',HexStr(n,8)); end; readln; } BeginThread(@_thread); //BeginThread(@_thread); //BeginThread(@_thread); NtSetEvent(event,nil); //e:=_do_lock_umtx(@mtx,GetCurrentThreadId); //Writeln(' lock[',GetCurrentThreadId,'] ',e); //e:=do_unlock_umtx(@mtx,GetCurrentThreadId); //Writeln('unlock[',GetCurrentThreadId,'] ',e); // //e:=_do_lock_umtx(@mtx,GetCurrentThreadId); //Writeln(' lock[',GetCurrentThreadId,'] ',e); // //e:=do_unlock_umtx(@mtx,GetCurrentThreadId); //Writeln('unlock[',GetCurrentThreadId,'] ',e); //_umutex_done(@mtx); readln; end.