level0/urforth0_w_osface.asm

   1 ;; Native x86 GNU/Linux Forth System, Direct Threaded Code
   2 ;;
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;;
   5 ;; This program is free software: you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation, version 3 of the License ONLY.
   8 ;;
   9 ;; This program is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;; GNU General Public License for more details.
  13 ;;
  14 ;; You should have received a copy of the GNU General Public License
  15 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17
  18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19 ;; ensure that the string at EDI with length in ECX is asciiz
  20 ;; returns new EDI if necessary
  21 ;; doesn't modify other registers (except flags)
  22 ;; but sets carry if ECX is invalid
  23 ;; rejects empty strings
  24 ;; may allocate temp pool, so take care of releasing it
  25 ;;
  26 urword_code "(DONT-CALL-OSFACE-CSTR)",par_dontcall_osface_cstr
  27 urword_uses par_no_call_temp_pool_subs
  28 urword_hidden
  29 ensure_asciiz_edi_ecx:
  30   or    ecx,ecx
  31   jr    z,.fucked
  32   test  ecx,0x80000000
  33   jr    nz,.fucked
  34   push  edi
  35   add   edi,ecx
  36   cp    byte [edi],0
  37   pop   edi
  38   jr    nz,@f
  39   or    ecx,ecx   ; reset carry flag
  40   ret
  41 @@:
  42   push  eax
  43   push  ecx
  44   push  esi
  45   ld    esi,edi
  46   ld    eax,ecx
  47   inc   eax       ; for trailing zero
  48   call  urpool_alloc
  49   push  edi       ; save new address
  50   rep   movsb     ; copy string
  51   xor   al,al     ; store trailing zero
  52   stosb
  53   pop   edi       ; restore new address (we'll return it)
  54   pop   esi       ; restore ESI (because we promised to not change it)
  55   pop   ecx       ; restore length (just in case)
  56   pop   eax       ; restore EAX (because we promised to not change it)
  57   or    ecx,ecx   ; reset carry flag
  58   ret
  59 .fucked:
  60   scf
  61   ret
  62 urword_end
  63
  64
  65 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  66 urword_code "(DLCLOSE)",par_dlclose
  67 ;; ( handle-or-0 -- )
  68   or    TOS,TOS
  69   jr    z,fword_par_dlclose_fucked
  70   ; push registers
  71   push  EIP
  72   push  ERP
  73   ; call
  74   push  TOS
  75   call  [elfimp_dlclose]
  76   add   esp,4   ; remove args
  77 fword_par_dlclose_fucked:
  78   pop   TOS
  79   urnext
  80 urword_end
  81
  82 urword_code "(DLOPEN)",par_dlopen
  83 ;; ( addr count -- handle-or-0 )
  84 urword_uses par_dontcall_osface_cstr
  85   pop   edi
  86   ; save pool mark
  87   call  urpool_mark
  88   push  eax
  89   call  ensure_asciiz_edi_ecx
  90   jr    c,fword_par_dlopen_fucked
  91   ; save registers
  92   push  EIP
  93   push  ERP
  94   ; call function
  95   ld    eax,1+256+8   ; RTLD_LAZY+RTLD_GLOBAL+RTLD_DEEPBIND
  96   push  eax
  97   push  edi
  98   call  [elfimp_dlopen]
  99   add   esp,4*2       ; remove arguments
 100   ; restore registers
 101   pop   ERP
 102   pop   EIP
 103   ld    TOS,eax
 104   ; restore pool
 105   pop   eax
 106   call  urpool_release
 107   urnext
 108 fword_par_dlopen_fucked:
 109   xor   TOS,TOS
 110   ; restore pool
 111   pop   eax
 112   call  urpool_release
 113   urnext
 114 urword_end
 115
 116 urword_code "(DLSYM)",par_dlsym
 117 ;; ( addr count handle -- address-or-0 )
 118 urword_uses par_dontcall_osface_cstr
 119   ld    FREEREG,TOS   ; save handle
 120   pop   ecx
 121   pop   edi
 122   ; save pool mark
 123   call  urpool_mark
 124   push  eax
 125   call  ensure_asciiz_edi_ecx
 126   jr    c,fword_par_dlsym_fucked
 127   ; save registers
 128   push  EIP
 129   push  ERP
 130   ; call function
 131   push  edi
 132   push  FREEREG
 133   call  [elfimp_dlsym]
 134   add   esp,4*2       ; remove arguments
 135   ; restore registers
 136   pop   ERP
 137   pop   EIP
 138   ld    TOS,eax
 139   ; restore pool
 140   pop   eax
 141   call  urpool_release
 142   urnext
 143 fword_par_dlsym_fucked:
 144   xor   TOS,TOS
 145   ; restore pool
 146   pop   eax
 147   call  urpool_release
 148   urnext
 149 urword_end
 150
 151 urword_const "RTLD_DEFAULT",rtld_default,0
 152 urword_const "RTLD_NEXT",rtld_next,-1
 153
 154
 155 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 156 urword_code "(FCLOSE)",par_fclose
 157 ;; ( fd -- flag )
 158   ; save registers
 159   push  EIP
 160   push  ERP
 161   ; syscall
 162   ld    eax,6
 163   ld    ebx,TOS
 164   syscall
 165   ; restore registers
 166   pop   ERP
 167   pop   EIP
 168   ld    TOS,eax
 169   urnext
 170 urword_end
 171
 172 urword_code "(FOPEN)",par_fopen
 173 ;; ( addr count flags mode -- fd-or-minusone )
 174 urword_uses par_dontcall_osface_cstr
 175   pop   edx   ; flags
 176   pop   eax   ; count
 177   pop   edi   ; addr
 178   xchg  eax,ecx
 179   ; EDX: flags
 180   ; EAX: mode
 181   ; ECX: count
 182   ; EDI: addr
 183   push  eax
 184   ; save pool mark
 185   call  urpool_mark
 186   xchg  eax,[esp]
 187   call  ensure_asciiz_edi_ecx
 188   jr    c,@f
 189   ; save registers
 190   push  EIP
 191   push  ERP
 192   ; syscall
 193   ld    ebx,edi
 194   ld    ecx,edx
 195   ld    edx,eax
 196   ld    eax,5
 197   syscall
 198   ; restore registers
 199   pop   ERP
 200   pop   EIP
 201   ld    TOS,eax
 202   ; restore pool
 203   pop   eax
 204   call  urpool_release
 205   urnext
 206 @@:
 207   ld    TOS,-1
 208   ; restore pool
 209   pop   eax
 210   call  urpool_release
 211   urnext
 212 urword_end
 213
 214 urword_code "(FREAD)",par_fread
 215 ;; ( addr count fd -- count )
 216   pop   edx   ; count
 217   pop   edi   ; addr
 218   ; save registers
 219   push  EIP
 220   push  ERP
 221   ; syscall
 222   ld    eax,3
 223   ld    ebx,TOS
 224   ld    ecx,edi
 225   syscall
 226   ; restore registers
 227   pop   ERP
 228   pop   EIP
 229   ld    TOS,eax
 230   urnext
 231 urword_end
 232
 233 urword_code "(FWRITE)",par_fwrite
 234 ;; ( addr count fd -- count )
 235   pop   edx   ; count
 236   pop   edi   ; addr
 237   ; save registers
 238   push  EIP
 239   push  ERP
 240   ; syscall
 241   ld    eax,4
 242   ld    ebx,TOS
 243   ld    ecx,edi
 244   syscall
 245   ; restore registers
 246   pop   ERP
 247   pop   EIP
 248   ld    TOS,eax
 249   urnext
 250 urword_end
 251
 252 urword_code "(LSEEK)",par_lseek
 253 ;; ( ofs whence fd -- res )
 254   ld    ebx,ecx
 255   pop   edx
 256   pop   ecx
 257   ; save registers
 258   push  EIP
 259   push  ERP
 260   ; syscall
 261   ld    eax,19
 262   ;ld    ebx,fd
 263   ;ld    ecx,offt
 264   ;ld    edx,whence
 265   syscall
 266   ; restore registers
 267   pop   ERP
 268   pop   EIP
 269   ld    TOS,eax
 270   urnext
 271 urword_end
 272
 273
 274 urword_const "O-RDONLY",o_rdonly,0
 275 urword_const "O-WRONLY",o_wronly,1
 276 urword_const "O-RDWR",o_rdwr,2
 277
 278 urword_const "O-CREAT",    o_creat,    0x000040  ; 0100
 279 urword_const "O-EXCL",     o_excl,     0x000080  ; 0200
 280 urword_const "O-NOCTTY",   o_noctty,   0x000100  ; 0400
 281 urword_const "O-TRUNC",    o_trunc,    0x000200  ; 01000
 282 urword_const "O-APPEND",   o_append,   0x000400  ; 02000
 283 urword_const "O-NONBLOCK", o_nonblock, 0x000800  ; 04000
 284 urword_const "O-DSYNC",    o_dsync,    0x001000  ; 010000
 285 urword_const "O-SYNC",     o_sync,     0x101000  ; 04010000
 286 urword_const "O-RSYNC",    o_rsync,    0x101000  ; 04010000
 287 urword_const "O-DIRECTORY",o_directory,0x010000  ; 0200000
 288 urword_const "O-NOFOLLOW", o_nofollow, 0x020000  ; 0400000
 289 urword_const "O-CLOEXEC",  o_cloexec,  0x080000  ; 02000000
 290
 291 urword_const "O-ASYNC",    o_async,    0x002000  ; 020000
 292 urword_const "O-DIRECT",   o_direct,   0x004000  ; 040000
 293 urword_const "O-LARGEFILE",o_largefile,0x008000  ; 0100000
 294 urword_const "O-NOATIME",  o_noatime,  0x040000  ; 01000000
 295 urword_const "O-PATH",     o_path,     0x200000  ; 010000000
 296 urword_const "O-TMPFILE",  o_tmpfile,  0x410000  ; 020200000
 297 urword_const "O-NDELAY",   o_ndelay,   0x000800  ; 04000
 298
 299 urword_const "O-CREATE-WRONLY-FLAGS",o_create_wronly_flags,(1 or 0x000040 or 0x000200)
 300 urword_const "O-CREATE-MODE-NORMAL",o_create_mode_normal,(0x100 or 0x080 or 0x020 or 0x004)
 301
 302 urword_const "(SEEK-SET)",seek_set,0
 303 urword_const "(SEEK-CUR)",seek_cur,1
 304 urword_const "(SEEK-END)",seek_end,2
 305
 306 urword_const "S-ISUID",s_isuid,0x800  ; 04000
 307 urword_const "S-ISGID",s_isgid,0x400  ; 02000
 308 urword_const "S-ISVTX",s_isvtx,0x200  ; 01000
 309 urword_const "S-IRUSR",s_irusr,0x100  ; 0400
 310 urword_const "S-IWUSR",s_iwusr,0x080  ; 0200
 311 urword_const "S-IXUSR",s_ixusr,0x040  ; 0100
 312 urword_const "S-IRWXU",s_irwxu,0x1c0  ; 0700
 313 urword_const "S-IRGRP",s_irgrp,0x020  ; 0040
 314 urword_const "S-IWGRP",s_iwgrp,0x010  ; 0020
 315 urword_const "S-IXGRP",s_ixgrp,0x008  ; 0010
 316 urword_const "S-IRWXG",s_irwxg,0x038  ; 0070
 317 urword_const "S-IROTH",s_iroth,0x004  ; 0004
 318 urword_const "S-IWOTH",s_iwoth,0x002  ; 0002
 319 urword_const "S-IXOTH",s_ixoth,0x001  ; 0001
 320 urword_const "S-IRWXO",s_irwxo,0x007  ; 0007
 321
 322
 323 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 324 struc stat {
 325   .st_dev        rd 1
 326   .st_ino        rd 1
 327   .st_mode       rw 1
 328   .st_nlink      rw 1
 329   .st_uid        rw 1
 330   .st_gid        rw 1
 331   .st_rdev       rd 1
 332   .st_size       rd 1
 333   .st_blksize    rd 1
 334   .st_blocks     rd 1
 335   .st_atime      rd 1
 336   .st_atime_nsec rd 1
 337   .st_mtime      rd 1
 338   .st_mtime_nsec rd 1
 339   .st_ctime      rd 1
 340   .st_ctime_nsec rd 1
 341   .__unused4     rd 1
 342   .__unused5     rd 1
 343   .statsize      rd 0
 344 }
 345
 346 virtual at 0
 347   statshit stat
 348 end virtual
 349
 350
 351 ;; is regular file?
 352 urword_code "(FILE?)",par_is_file
 353 ;; ( addr count -- flag )
 354 urword_uses par_dontcall_osface_cstr
 355   pop   edi   ; addr
 356   ; ECX: count
 357   ; EDI: addr
 358   push  eax   ; dummy
 359   ; save pool mark
 360   call  urpool_mark
 361   xchg  eax,[esp]
 362   call  ensure_asciiz_edi_ecx
 363   jr    c,@f
 364   ; save registers
 365   push  EIP
 366   push  ERP
 367   ; alloc stat struct
 368   sub   esp,statshit.statsize
 369   ; syscall
 370   ld    eax,106
 371   ld    ebx,edi
 372   ld    ecx,esp
 373   syscall
 374   ; get mode to ecx
 375   movzx TOS,word [esp+statshit.st_mode]
 376   ; drop stat struct
 377   add   esp,statshit.statsize
 378   ; restore registers
 379   pop   ERP
 380   pop   EIP
 381   or    eax,eax
 382   jr    nz,@f
 383   ; check flags
 384   and   TOS,0x8000  ; 0100000, S_IFREG
 385   jr    z,@f
 386   ; restore pool
 387   pop   eax
 388   call  urpool_release
 389   ld    TOS,1
 390   urnext
 391 @@:
 392   xor   TOS,TOS
 393   ; restore pool
 394   pop   eax
 395   call  urpool_release
 396   urnext
 397 urword_end
 398
 399 ;; is directory?
 400 urword_code "(DIR?)",par_is_dir
 401 ;; ( addr count -- flag )
 402 urword_uses par_dontcall_osface_cstr
 403   pop   edi   ; addr
 404   ; ECX: count
 405   ; EDI: addr
 406   push  eax   ; dummy
 407   ; save pool mark
 408   call  urpool_mark
 409   xchg  eax,[esp]
 410   call  ensure_asciiz_edi_ecx
 411   jr    c,@f
 412   ; save registers
 413   push  EIP
 414   push  ERP
 415   ; alloc stat struct
 416   sub   esp,statshit.statsize
 417   ; syscall
 418   ld    eax,106
 419   ld    ebx,edi
 420   ld    ecx,esp
 421   syscall
 422   ; get mode to ecx
 423   movzx TOS,word [esp+statshit.st_mode]
 424   ; drop stat struct
 425   add   esp,statshit.statsize
 426   ; restore registers
 427   pop   ERP
 428   pop   EIP
 429   or    eax,eax
 430   jr    nz,@f
 431   ; check flags
 432   and   TOS,0x4000  ; 0040000, S_IFDIR
 433   jr    z,@f
 434   ; restore pool
 435   pop   eax
 436   call  urpool_release
 437   ld    TOS,1
 438   urnext
 439 @@:
 440   xor   TOS,TOS
 441   ; restore pool
 442   pop   eax
 443   call  urpool_release
 444   urnext
 445 urword_end
 446
 447
 448 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 449 ;; get seconds since epoch
 450 urword_code "SYS-TIME",sys_time
 451 ;; ( -- seconds )
 452   push  TOS
 453   push  EIP
 454   push  ERP
 455   ld    eax,13   ; sys_time
 456   xor   ebx,ebx  ; result only in eax
 457   syscall
 458   pop   ERP
 459   pop   EIP
 460   ld    TOS,eax
 461   urnext
 462 urword_end
 463
 464 urword_const "CLOCK_REALTIME",clock_realtime,0
 465 urword_const "CLOCK_MONOTONIC",clock_mono,1
 466 urword_const "CLOCK_PROCESS_CPUTIME_ID",clock_process_cpu,2
 467 urword_const "CLOCK_THREAD_CPUTIME_ID",clock_thread_cpu,3
 468 urword_const "CLOCK_MONOTONIC_RAW",clock_mono_raw,4
 469 urword_const "CLOCK_REALTIME_COARSE",clock_realtime_coarse,5
 470 urword_const "CLOCK_MONOTONIC_COARSE",clock_mono_coarse,6
 471 urword_const "CLOCK_BOOTTIME",clock_boot,7
 472 urword_const "CLOCK_REALTIME_ALARM",clock_realtime_alarm,8
 473 urword_const "CLOCK_BOOTTIME_ALARM",clock_boot_alarm,9
 474
 475 urword_const "NANOSECONS-PER-SECOND",nano_per_second,1000000000
 476 urword_const "NANOSECONS-PER-MSEC",nano_per_msec,1000000
 477
 478 ;; get seconds and nanoseconds (since some random starting point)
 479 urword_code "SYS-CLOCK-GETTIME",sys_clock_gettime
 480 ;; ( clockid -- seconds nanoseconds )
 481   push  EIP
 482   push  ERP
 483   sub   esp,4+4  ; timespec
 484   ld    eax,265  ; sys_clock_gettime
 485   ld    ebx,TOS  ; clockid
 486   ld    ecx,esp
 487   syscall
 488   or    eax,eax
 489   jr    nz,.error
 490   ld    eax,[esp]    ; seconds
 491   ld    TOS,[esp+4]  ; nanoseconds
 492   add   esp,4+4
 493   pop   ERP
 494   pop   EIP
 495   push  eax
 496   urnext
 497 .error:
 498   add   esp,4+4
 499   pop   ERP
 500   pop   EIP
 501   xor   TOS,TOS
 502   push  TOS
 503   urnext
 504 urword_end
 505
 506
 507 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 508 urword_const "(SYS-GETTICKCOUNT-START-SECS)",sys_gettickccount_start_secs,0
 509 urword_hidden
 510
 511 urword_forth "(SYS-GETTICKCOUNT-INIT)",sys_gettickcount_init
 512 urword_hidden
 513 ;; ( -- )
 514   UF clock_mono sys_clock_gettime drop
 515   UF dup 1 great
 516   ur_if
 517     UF 1dec
 518   ur_endif
 519   urlit fconst_sys_gettickccount_start_secs_data
 520   UF !
 521 urword_end
 522
 523
 524 urword_forth "SYS-GETTICKCOUNT",sys_gettickcount
 525   UF clock_mono sys_clock_gettime
 526   UF nano_per_msec udiv
 527   UF swap sys_gettickccount_start_secs - 1000 umul
 528   UF +
 529 urword_end
 530
 531
 532 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 533 urword_code "(CINVOKE)",par_cinvoke
 534 ;; ( ... argcount addr -- res )
 535 ;; call c function
 536   rpush TOS
 537   pop   eax
 538   rpush eax
 539   call  eax
 540   mov   TOS,eax
 541   rpop  edx
 542   shl   edx,2
 543   add   esp,edx
 544   rpop  TOS
 545   push  TOS
 546   urnext
 547 urword_end
 548
 549
 550 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 551 ;; urword_const "MAP-FILE"            ,0x00000000
 552 ;; urword_const "MAP-SHARED"          ,0x00000001
 553 ;; urword_const "MAP-PRIVATE"         ,0x00000002
 554 ;; urword_const "MAP-SHARED_VALIDATE" ,0x00000003
 555 ;; urword_const "MAP-TYPE"            ,0x0000000f
 556 ;; urword_const "MAP-FIXED"           ,0x00000010
 557 ;; urword_const "MAP-ANON"            ,0x00000020
 558 ;; urword_const "MAP-ANONYMOUS"       ,0x00000020
 559 ;; urword_const "MAP-NORESERVE"       ,0x00004000
 560 ;; urword_const "MAP-GROWSDOWN"       ,0x00000100
 561 ;; urword_const "MAP-DENYWRITE"       ,0x00000800
 562 ;; urword_const "MAP-EXECUTABLE"      ,0x00001000
 563 ;; urword_const "MAP-LOCKED"          ,0x00002000
 564 ;; urword_const "MAP-POPULATE"        ,0x00008000
 565 ;; urword_const "MAP-NONBLOCK"        ,0x00010000
 566 ;; urword_const "MAP-STACK"           ,0x00020000
 567 ;; urword_const "MAP-HUGETLB"         ,0x00040000
 568 ;; urword_const "MAP-SYNC"            ,0x00080000
 569 ;; urword_const "MAP-FIXED_NOREPLACE" ,0x00100000
 570
 571 ;; urword_const "PROT-NONE"  ,0
 572 ;; urword_const "PROT-READ"  ,1
 573 ;; urword_const "PROT-WRITE" ,2
 574 ;; urword_const "PROT-EXEC"  ,4
 575 urword_const "PROT-R/W",mmap_const_prot_rw,3
 576
 577 ;; urword_const "PROT-GROWSDOWN" ,0x01000000
 578 ;; urword_const "PROT-GROWSUP"   ,0x02000000
 579
 580 ;; WARNING! this can return negative for high addresses
 581 ;;          therefore, check for error like this:
 582 ;;          err -4095 0 within, or use "MMAP-ERROR?"
 583 ;; it is ok to use "0" as modeflags, they will be set to private
 584 urword_code "MMAP",mmap  ;;( size protflags -- addr true // error false )
 585   ;; fix flags (we always doing anon private alloc)
 586   xor   ebx,ebx  ;; address
 587   ld    edx,TOS  ;; protflags
 588   pop   ecx      ;; size
 589   push  EIP
 590   push  ERP
 591   ld    esi,0x0000_0022  ;; we always doing anon private alloc
 592   xor   ebp,ebp  ;; offset, it is ignored, but why not
 593   xor   edi,edi  ;; fd (-1)
 594   dec   edi
 595   ld    eax,192
 596   syscall
 597   pop   ERP
 598   pop   EIP
 599   push  eax
 600   cp    eax,0xfffff000
 601   setc  cl
 602   movzx TOS,cl
 603   urnext
 604 urword_end
 605
 606 urword_code "MUNMAP",munmap  ;;( addr size -- res )
 607   pop   ebx
 608   push  EIP
 609   push  ERP
 610   ld    eax,91
 611   syscall
 612   pop   ERP
 613   pop   EIP
 614   ld    TOS,eax
 615   urnext
 616 urword_end